VBA question - Keep copying the data in one page from different spreadsheets

[Canoirode]

Hello all

I am sorry I am a VBA beginner and it is also my first post here.

So here is what I am trying to achieve:

I need to copy and paste the data from a spreadsheet (Sheet2) into a main one (Sheet1). However, once I finished to copy the data from Sheet2, I need to do the same exercise but from Sheet3, then Sheet4 and etc...

So far, this is where I am. It works but I still cannot get my head around the transition into different spreadsheets...

If you could help me this would be amazing.

Thank you,

Sub Loop2()


'Have x start at row2
x = 2


'Loop until a blank row is found


Do While ThisWorkbook.Sheets("sheet2").Cells(x, 2).Value <> ""
'This will copy data from Page2 in Page1


ThisWorkbook.Sheets("sheet2").Range("A:C").Copy ThisWorkbook.Sheets("sheet1").Range("A:C")


x = x + 1
Loop
End Sub

 

[Canoirode]

Guys, I found a quote macro that nearly allows me to do what I need... I just need to extend the number of columns:

Sub CopyToMaster()


ShtCount = ActiveWorkbook.Sheets.Count


For i = 2 To ShtCount


Worksheets(i).Activate
LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row


Range("A2:J" & LastRow).Select


Selection.Copy
Sheets("Master").Activate


LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Select


'Required after first paste to shift active cell down one
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop


ActiveCell.Offset(0, -3).Select
Selection.PasteSpecial




Next i
End Sub

 

[Fluff]

What range of cells do you need? In your 1st post you used A:C, but the 2nd post is A:J & you want to extend it?
This code will copy A:C from each sheet to the foot of sheet1. So let me know what ranges you need & I'll tweak it

Sub Canoirode()

    Dim Ws As Variant
    Dim NxtRw As Long
    Dim UsdRws As Long


    For Each Ws In Worksheets
        If Not Ws.Name = "Sheet1" Then
            NxtRw = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
            UsdRws = Ws.Range("A2").End(xlDown).Row
            Ws.Range("A2:C" & UsdRws).Copy Sheets("sheet1").Range("A" & NxtRw)
        End If
    Next Ws

End Sub

 

[Canoirode]

This is perfect!!!!! Thank you!!!!!!!!!!

 

[Canoirode]

Out of curiosity, how would you specify two ranges in your script?

For instance "A:C" and "M:P"

Thanks a million anyway

 

[Canoirode]

This works but not sure that it is efficient:
Sub Canoirode()


Dim Ws As Variant
Dim NxtRw As Long
Dim UsdRws As Long




For Each Ws In Worksheets
If Not Ws.Name = "Sheet1" Then
NxtRw = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
UsdRws = Ws.Range("A2").End(xlDown).Row
Ws.Range("A2:C" & UsdRws).Copy Sheets("sheet1").Range("A" & NxtRw)
NxtRw = Sheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Row
UsdRws = Ws.Range("M2").End(xlDown).Row
Ws.Range("M2:P" & UsdRws).Copy Sheets("sheet1").Range("M" & NxtRw)
End If
Next Ws


End Sub

 

[Fluff]

This is perfect!!!!! Thank you!!!!!!!!!!

Thanks for the feedback, just glad to help

 

[Fluff]

Out of curiosity, how would you specify two ranges in your script?

For instance "A:C" and "M:P"

Thanks a million anyway

Depends on what you need.
If you want M:P to go into D:G then

    For Each Ws In Worksheets
        If Not Ws.Name = "Sheet1" Then
            NxtRw = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
            UsdRws = Ws.Range("A2").End(xlDown).Row
            Ws.Range("A2:C" & UsdRws & ",M2:P" & UsdRws).Copy Sheets("sheet1").Range("A" & NxtRw)
        End If
    Next Ws

But if you want to keep them in M:P

    For Each Ws In Worksheets
        If Not Ws.Name = "Sheet1" Then
            NxtRw = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
            UsdRws = Ws.Range("A2").End(xlDown).Row
            Ws.Range("A2:C" & UsdRws).Copy Sheets("sheet1").Range("A" & NxtRw)
            Ws.Range("M2:P" & UsdRws).Copy Sheets("sheet1").Range("M" & NxtRw)
        End If
    Next Ws

EDIT:
No need for the extra NxtRw or UsdRws lines

 

[Canoirode]

Just tried this:

Sub Canoirode()


Dim Ws As Variant
Dim NxtRw As Long
Dim UsdRws As Long





For Each Ws In Worksheets
If Not Ws.Name = "Sheet1" Then
NxtRw = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
UsdRws = Ws.Range("A2").End(xlDown).Row
Ws.Range("A3:C" & UsdRws).Copy Sheets("Sheet1").Range("A" & NxtRw)
Ws.Range("F3:I" & UsdRws).Copy Sheets("Sheet1").Range("F" & NxtRw)
End If
Next Ws



End Sub

It works perfectly but I get this error message:

"Run-Time error '1004':
Application-Defined or object -defined error

Not sure if I should be worried since it seems to be fine.

Thanks again a million for your time.

 

[Fluff]

It works perfectly but I get this error message:

"Run-Time error '1004':
Application-Defined or object -defined error

Do you have any other code in the workbook? Especially any worksheet or workbook events.
If you are getting an error message, then something is not working.