PDA

View Full Version : VBA loop copy & paste range to same worksheet name of another workbook



chloe29
07-09-2019, 08:24 AM
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
07-09-2019, 10:49 AM
Cross posted multiple sites

Please read
http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3