VBA to Copy and Paste From One Workbook to Another

[rbellavance22]

Hello,

I have two workbooks, 2018 and 2019. Both have 100+ tabs with different names.

2018 has data in various cells throughout each tab.

2019 has the same number of tabs with the same titles as 2018, but is completely blank otherwise.

I would like to copy multiple cells from 2018 (A4, B18, C86, C88 & D1) and paste them into a different cell (A4 in 2018 gets pasted into A12 in 2019, etc.) in the corresponding tab in the 2019 workbook.

Any and all help would be much appreciated.

Thank you.

 

[mumps]

You mentioned where A4 in 2018 gets pasted. What about B18, C86, C88 and D1?

 

[rbellavance22]

Sure, B18 get pasted to B89, C86 get pasted to C88 and D1 gets pasted to J18.

Thank you.

You mentioned where A4 in 2018 gets pasted. What about B18, C86, C88 and D1?

 

[mumps]

Make sure that both workbooks are open. Place this macro in the "2018" workbook. Change the workbook name in the code (in red) to suit your needs.

Sub CopyCells()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, desWB As Workbook
    Set desWB = Workbooks("[COLOR="#FF0000"]2019.xlsx[/COLOR]")
    For Each ws In Sheets
        With desWB
            With .Sheets(ws.Name)
                .Range("A12") = ws.Range("A4")
                .Range("B89") = ws.Range("B18")
                .Range("C88") = ws.Range("C8")
                .Range("J18") = ws.Range("D1")
            End With
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[rbellavance22]

This is incredible. You saved me hours, and hours, and hours of data entry. Thank you so much!!

Make sure that both workbooks are open. Place this macro in the "2018" workbook. Change the workbook name in the code (in red) to suit your needs.

Sub CopyCells()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, desWB As Workbook
    Set desWB = Workbooks("[COLOR=#FF0000]2019.xlsx[/COLOR]")
    For Each ws In Sheets
        With desWB
            With .Sheets(ws.Name)
                .Range("A12") = ws.Range("A4")
                .Range("B89") = ws.Range("B18")
                .Range("C88") = ws.Range("C8")
                .Range("J18") = ws.Range("D1")
            End With
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[mumps]

You are very welcome.