I would like to loop copy paste data from One Workbook to Another Workbook's sheets with same names?

Question

So I have some Workbooks (2020 & 2021). Each have 12 Sheets which are based on Month Name eg Jan, Feb, March.

So I would like to write a code to paste data from Sheet("Jan") to Sheet("Jan") and so on from the Workbook 2020 to Workbook 2021 in simple codes.

To do so I have written 25 Codes 12 to Copy and 12 to paste and one Master code to Run all of them.

Is there better alternative to Copy paste them by shortest easiest possible code.

Can I do it with loop. Match Sheets Name and Paste from One Workbook to Another.

Below is example of Code I have written.

Sub Master_Code()
Call_Jan_Copy
Call_Feb_Copy
Call_Mar_Copy
Call_Apr_Copy
Call_May_Copy
Call_Jun_Copy
Call_Jul_Copy
Call_Aug_Copy
Call_Sep_Copy
Call_Oct_Copy
Call_Nov_Copy
Call_Dec_Copy
End Sub


Sub Jan_Copy()'Code-1
Sheets("Jan").Select
ActiveSheet.Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Call Jan_Paste
End Sub


Sub Jan_Paste()'Code-2
Sheets("Jan").Select
ActiveSheet.Range("A1").Select
ActiveSheet.Range("A1048576").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial xlPasteAll
Application.CutCopyMode = False
End Sub'

Why not use [Worksheet.Copy](https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.copy)? Just make sure the destination workbook does not have a worksheet of the same name (do a check and delete first if exist?). You will also benefit from reading on [how to avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — Raymond Wu, Feb 15 '22 at 05:34
If you don't mind copying the code, you could use this one-liner: `ThisWorkbook.SaveCopyAs Replace(ThisWorkbook.FullName, "2020.xlsm", "2021.xlsm")`. — VBasic2008, Feb 15 '22 at 05:42
Well both WB has data, I need to copy paste from one place to another. Its for day to day and Month to Comparison Purpose. So Every Week or Day I have to Compare data of 01-Jan 2020 to 01-Jan-Jan 2021 for Each month and Each day. So I just cant Rename or Move Sheets. Anyway Thanks. PS: I may have to use the same method somewhere else too. — Pritam Singh, Feb 15 '22 at 05:50

chris neilsen · Answer 1 · 2022-02-15T18:55:41.503

Don't rely on ActiveSheet or ActiveWorkbook. Use references instead

Something like

Sub CopyMonths()
    Dim wbSrc As Workbook
    Dim wbDst As Workbook
    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
    
    Set wbSrc = Application.Workbooks("NameOfYourSourceBook.xlsx/m/b")  ' Update to your book name, including extension
    Set wbDst = Application.Workbooks("NameOfYourDestinationBook.xlsx/m/b") ' Update to your book name, including extension
    
    For Each wsSrc In wbSrc.Worksheets
        Set wsDst = wbDst.Worksheets(wsSrc.Name)
        
        wsSrc.UsedRange.Copy
        wsDst.Cells(1, 1).PasteSpecial xlPasteAll
    Next
End Sub

You might want to consider what to do if

Source wb has more sheets (test for some distinguishing feature before copying)
Dest wb is missing one of the sheets (test for existing, create if missing)
There is existing data on some dest sheets (clear sheet, or paste below)

Thanks Chris. Worked good. However There is one small problem which is Some Source WB has few extra sheets whose name does not match with Destination WB and data of those extra sheets is getting copied too on the last sheets of Destination WB. Am trying to skip those but have not found good solution yet. — Pritam Singh, Feb 15 '22 at 13:08
Well, that would have been useful info instead of _Each have 12 Sheets ..._ — chris neilsen, Feb 15 '22 at 18:49

score 0 · Answer 2 · answered Feb 15 '22 at 06:13

0

Append Worksheet Data

Option Explicit

Sub AppendLastYear()
    
    Const sFilePath As String = "C:\Test\2020.xlsm"
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    
    Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath)
    
    Application.ScreenUpdating = False
    
    Dim sws As Worksheet
    Dim srg As Range
    Dim dws As Worksheet
    Dim dfCell As Range
    
    For Each dws In dwb.Worksheets
        Set dfCell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
        Set sws = swb.Worksheets(dws.Name)
        With sws.Range("A1").CurrentRegion
            Set srg = .Resize(.Rows.Count - 1).Offset(1)
        End With
        srg.Copy dfCell
    Next dws
    
    swb.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    
    MsgBox "Last year appended.", vbInformation
    
End Sub

answered Feb 15 '22 at 06:13

VBasic2008

44,888
5
17
28

Thanks Buddy! It worked as well. However data from some extra sheets of Source WB are getting copied to on the last sheet of Destination WB. Which I am trying to skip. But have not found the solution yet. – Pritam Singh Feb 15 '22 at 13:08
You may have copied my first attempt. Try to copy this code. It loops through the worksheets of the destination workbook, so there's no way that something that doesn't exist in the destination workbook is being copied. – VBasic2008 Feb 15 '22 at 13:23
Thanks!!! Really appreciate your effort on helping others. – Pritam Singh Feb 15 '22 at 13:42

I would like to loop copy paste data from One Workbook to Another Workbook's sheets with same names?

2 Answers2

Append Worksheet Data