Excel VBA：检查工作表是否存在; 复制/粘贴到新工作表 – 粘贴失败
我有一个macros从一个工作表（ Sheet1 ）复制/粘贴到另一个工作表（ Notes ）。 它运作良好。 现在我想先检查该工作表是否存在。 如果它不存在，我想创build它，然后继续复制/粘贴select。
当“ Notes ”工作表存在时，复制/粘贴工作正常。 如果工作表不存在，则创build它，但粘贴操作不起作用。 我没有得到任何错误。 我必须重新运行macros，然后粘贴工作（因为工作表已经被创build）。 任何想法，我错过了什么？
Sub Copy2sheet() Application.ScreenUpdating = False Dim copySheet As Worksheet Dim pasteSheet As Worksheet Dim mySheetName As String, mySheetNameTest As String mySheetName = "Notes" 'create worksheet at end of workbook if it does not exist On Error Resume Next mySheetNameTest = Worksheets(mySheetName).Name If Err.Number = 0 Then GoTo CopyPasteSelection Else Err.Clear Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = mySheetName End If 'copy/paste selection to Notes worksheet CopyPasteSelection: Set copySheet = Worksheets("Sheet1") Set pasteSheet = Worksheets("Notes") Selection.Copy pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).PasteSpecial xlPasteAll Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
当您执行添加时，活动页将变成新的工作表，并且您之前的select将会丢失……………您必须在添加之前“记住”它：
Sub Copy2sheet() Application.ScreenUpdating = False Dim copySheet As Worksheet Dim pasteSheet As Worksheet Dim mySheetName As String, mySheetNameTest As String mySheetName = "Notes" Dim RtoCopy As Range Set RtoCopy = Selection 'create worksheet at end of workbook if it does not exist On Error Resume Next mySheetNameTest = Worksheets(mySheetName).Name If Err.Number = 0 Then GoTo CopyPasteSelection Else Err.Clear Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = mySheetName End If 'copy/paste selection to Notes worksheet CopyPasteSelection: Set copySheet = Worksheets("Sheet1") Set pasteSheet = Worksheets("Notes") RtoCopy.Copy pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).PasteSpecial xlPasteAll Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
请注意参考RtoCopy的三行 。
你的代码中有错误恢复。 第一次通过它快乐的方式。 第二次通过错误检查触发新选项卡的创build。
在错误恢复下一个是不好的。 不要使用它。
有关解决问题的更多信息，请参阅此问题如何检查Excel-VBA中是否存在某些表单？
您应该先激活并select要复制的工作表和范围。 这工作。
CopyPasteSelection: Set copySheet = Worksheets("Sheet1") Set pasteSheet = Worksheets("Notes") Worksheets("Sheet1").Activate 'Activete "Sheet1" Worksheets("Sheet1").Range("A1").Select 'Select the range to be copied 'Then copy selection Selection.Copy pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).PasteSpecial xlPasteAll Application.CutCopyMode = False Application.ScreenUpdating = True
我build议使用Function来获得更多的可重用性：
- 一个肮脏和快速的方式：
Function isWorksheetValid(wsName As String) ON Error Goto ErrHndl Dim ws as Worksheet Set ws = Sheets(wsName) isWorksheetValid = True Exit Function ErrHndl: isWorksheetValid = False End Function
- 一个正确但有点慢的方法：
Function isWorksheetValid(wsName As String) ON Error Goto ErrHndl Dim ws as Worksheet For Each ws in Sheets If (UCASE(ws.Name) = UCASE(wsName)) Then isWorksheetValid = True Exit Function End If Next ErrHndl: isWorksheetValid = False End Function
现在你需要像这样使用它：
If (isWorksheetValid(mySheetName) Then ' Add your code here End If