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
VBA 复制
最新推荐文章于 2024-07-15 21:31:41 发布