VBA 复制

Option Explicit

Sub Copy_Paste_1()
    
''    '通过对话框打开文件：
'    '方法一：
''    Dim a As Boolean
''    a = Application.FindFile
''    If a = True Then
''        MsgBox "Excel文件打开成功！", vbOKOnly
''    Else
''        MsgBox "你取消了打开文件操作", vbOKOnly
''    End If
'    '方法二:
'    'Application.Dialogs(xlDialogOpen).Show
' '----------------------------------------------
'
'    '通过对话框另存文件
'    Application.Dialogs(xlDialogSaveAs).Show
'    'Application.Dialogs(xlDialogSaveCopyAs).Show
'    '其他的内置函数根据实际情况查询使用
'
'    '激活表格
'    'Worksheets("Sheet1").Activate
 '----------------------------------------------
    '复制和粘贴
    
    Dim i As Integer, j As Integer, num As Integer
    Dim r As Long, c As Long
    Dim myRange As Range, CopyRange As Range
    Set myRange = ActiveSheet.UsedRange
    
    r = myRange.Rows.Count
    c = myRange.Columns.Count
    i = 1
    '查找语文所在行
    Do While myRange.Cells(i, 1) <> "语文"
        i = i + 1
    Loop
    num = i
    Debug.Print "语文所在行为：" & num
    
    '新建工作表
    If Sheets.Count > 3 Then
        Worksheets(Sheets.Count).Delete
    End If
    
    If Sheets.Count = 3 Then
        Worksheets.Add After:=Sheets(Sheets.Count)
        Worksheets(Sheets.Count).Name = "语文成绩汇总"
    End If
    
    '复制
    
    Set CopyRange = myRange.Cells(num, 1).Resize(1, c)
    CopyRange.Copy Worksheets(Sheets.Count).Range("1:1")
End Sub