I'm a beginner in VBA and I have a problem in above subject which I want to copy specific range from many sheets in workbook to one sheet in another workbook I searched the.net and finally I reached to a code which runs but it gives me the last sheet data only not all sheets
I have a Workbook (WB1) - Current Workbook
I have another Work Book (WB2) - Copy from Workbook
I have WS1 in the Current Workbook
I have WS2 in the Copy from Workbook
The Work sheets names in WB2 are Numbers like 1,2 and so on
I used the following code
Sub CollectData()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Application.DisplayAlerts = False
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("Path")
Set ws1 = wb1.Sheets("Jan")
For Each ws2 In wb2.Sheets
If Len(ws2.Name) > 0 Then
ws2.Range("A2:G50").Copy Destination:=ws1.Range("A2:G50")
End If
Next ws2
Application.DisplayAlerts = True
wb2.Close (savechanges = True)
The Code gives me data in the last sheet only?? in this case 2
Appreciate your support.
Thanks, Regards
I'm a beginner too and I'm typing on my tablet so I can't test your code but it looks like you are always pasting to the same range thus overwriting the previous pastes in your loop. Your destination range needs to be dynamic to paste in the next empty range so as to avoid overwriting.
Update:
I've had to time come back to this and as I had assumed you were copying over previous pastes with each run of your loop. My code is probably a bit crude but as I said I am still learning the basics myself. Update the "path" in the workbooks.open line and give this a go. It should work for you.
Sub CollectData()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim NextRow As Long
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Jan")
Application.DisplayAlerts = False
Set wb2 = Workbooks.Open("Path")
For Each ws2 In wb2.Sheets
If Len(ws2.Name) > 0 Then
NextRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws2.Range("A2:G50").Copy ws1.Range("A" & NextRow)
End If
Next ws2
Application.DisplayAlerts = True
wb2.Close True
End Sub
Option Explicit
Sub CollectData()
' Paste
Dim wb1 As Workbook
Set wb1 = ThisWorkbook
Dim ws1 As Worksheet
Set ws1 = wb1.Sheets("Jan")
Dim rng1 As Range ' Paste Range (First Cell Only)
' Copy
Dim wb2 As Workbook
Set wb2 = Workbooks.Open("F:\Test\64010480.xlsm")
Dim ws2 As Worksheet
Dim rng2 As Range ' Copy Range
' Loop through worksheets in Copy Workbook.
For Each ws2 In wb2.Worksheets
' Check if the current worksheet's name contains only one character
' (it cannot contain 0 characters).
If Len(ws2.Name) < 2 Then
' Define Copy Range.
Set rng2 = ws2.Range("A2:G50")
' Define first cell range of Paste Range.
Set rng1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Offset(1)
' Either (if you only need values)...
' Write values from Copy Range to Paste Range.
rng1.Resize(rng2.Rows.Count, rng2.Columns.Count).Value = rng2.Value
' ...or (if you also need formulas and formats).
' Copy data from Copy Range to Paste Range.
'rng2.Copy Destination:=rng1
End If
Next ws2
' Close Copy Workbook.
wb2.Close SaveChanges:=False ' No need to save it, we were just reading.
' Maybe you want to save the Paste Workbook.
'wb1.Save
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.