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

chloe29

New Member
Joined
Jan 19, 2016
Messages
4
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
 

Some videos you may like

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
35,509
Office Version
365
Platform
Windows
How about
Code:
    For Each SourceWs In SourceWb.Worksheets
    
        'Fill in the range that you want to copy
        Set CopyRng = SourceWs.Range("A2:A5")
        
        Set DestWs = DestWb.Worksheets(SourceWs.Name)
        
        With CopyRng
        DestWs.Cells(Last + 1, "A").Resize(.Rows.Count, .Columns.Count).Value = .Value
        End With
        
    Next
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
35,509
Office Version
365
Platform
Windows
Cross posted http://www.vbaexpress.com/forum/sho...ge-to-same-worksheet-name-of-another-workbook

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

Please supply a link to the other site(s) wher you have asked this question.
 
Last edited:

Forum statistics

Threads
1,089,201
Messages
5,406,803
Members
403,106
Latest member
AliO

This Week's Hot Topics

Top