VBA loop copy & paste range to same worksheet name of another workbook

[chloe29]

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

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

[Fluff]

Cross posted multiple sites

Please read
http://www.vbaexpress.com/forum/faq...._new_faq_item3