VBA loop copy & paste range to same worksheet name of another workbook
Hi, I'm trying to copy the same range of cells from all worksheets in Workbook1 and paste it in the respective same-named worksheet in Workbook2.
Example:
Copy Cells A2:A5 in Sheet1 of Workbook1
Paste to Cell A2 in Sheet1 of Workbook2
Copy Cells A2:A5 in Sheet2 of Workbook1
Paste to Cell A2 in Sheet2 of Workbook2
Copy Cells A2:A5 in Sheet3 of Workbook1
Paste to Cell A2 in Sheet3 of Workbook2
Repeat for all the other sheets.
----------------
However, with my coding below, the data did not paste to the correct worksheet. Any idea what went wrong? Thanks
Code:
Sub Button1_Click()
Dim SourceWb As Workbook, DestWb As Workbook
Dim SourceWs As Worksheet, DestWs As Worksheet
Dim WsName As String
Dim CopyRng As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set SourceWb = ThisWorkbook
'Set SourceWs = SourceWb.Worksheets
Set DestWb = Workbooks.Open("C:\Users\sy\Desktop\destination.xlsx", , True) 'Readonly = True
'Loop through all worksheets and copy the data to the DestWs
For Each SourceWs In SourceWb.Worksheets
'Fill in the range that you want to copy
Set CopyRng = SourceWs.Range("A2:A5")
CopyRng.Copy
WsName = SourceWb.ActiveSheet.Name
Set DestWs = DestWb.Worksheets(WsName)
With CopyRng
DestWs.Cells(Last + 1, "A").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
Next
ExitTheSub:
Application.Goto DestWs.Cells(1)
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
