I have a macro that copy/pastes a selection from one worksheet ( Sheet1
), to another worksheet ( Notes
). It works well. Now I want to first check if that worksheet exists. If it does not exist, I want to create it, then continue with the copy/pasting the selection.
When the " Notes
" worksheet exists, the copy/paste works fine. If the worksheet does not exist, it creates it, but the paste operation doesn't work. I don't get any errors. I have to rerun the macro and then the paste works (since the worksheet has already been created). Any ideas on what I missed?
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
When you do the Add, the activesheet becomes the new worksheet and your previous Selection is lost...............you must "remember" it before the Add :
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
Pay attention to the three lines referencing RtoCopy .
You have On Error Resume Next in your code. First time through it goes on its merry way. The second time through the Error check triggers the creation of the new tab.
On Error Resume Next is bad. Don't use it.
See this question for more information on solving your problem How to check whether certain sheets exist or not in Excel-VBA?
You should first activate and select the sheet and range to be copied. This works.
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
I suggest using Function
for more re-usability:
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
Now you need just use it like this:
If (isWorksheetValid(mySheetName) Then
' Add your code here
End If
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.