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]

I triple checked and everything is fine.

Opened a new document. I checked the script with F8 and error message only appears at the end of it.

This is the script that I put with the range that I need:

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("A3").End(xlDown).Row
Ws.Range("A3:F" & UsdRws).Copy Sheets("Sheet1").Range("A" & NxtRw)
Ws.Range("G3:K" & UsdRws).Copy Sheets("Sheet1").Range("G" & NxtRw)
End If
Next Ws





End Sub

I am sorry for being a pain! Thanks again for your help

 

[Fluff]

As you have changed the ranges on both lines, why not get rid of the second line & just run

Ws.Range("A3:K" & UsdRws).Copy Sheets("Sheet1").Range("A" & NxtRw)

As for the error, I'm afraid I cant help.

 

[Canoirode]

No worries at all! Thanks a million for your help.

 

[Canoirode]

Sorry Fluff,

I managed to fix everything and the macro is now running smoothly (the extra tab without any data was causing the error...).

Just one quick question.

If I run the macro twice. It doesn't overwrite the previous data but add them at the end of the first set.

Is it possible to change this? Everytime I run the macro it starts from A3.

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("A3").End(xlDown).Row
Ws.Range("A3:G" & UsdRws).Copy Sheets("Sheet1").Range("A" & NxtRw)
Ws.Range("J3:M" & UsdRws).Copy Sheets("Sheet1").Range("J" & NxtRw)

End If
Next Ws





End Sub



Thanks again for your help.

 

[Fluff]

Here you go

Sub Canoirode()

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

    LstRw = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Sheet1").Rows("3:" & LstRw).Delete

    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("A3").End(xlDown).Row
            Ws.Range("A3:G" & UsdRws).Copy Sheets("Sheet1").Range("A" & NxtRw)
            Ws.Range("J3:M" & UsdRws).Copy Sheets("Sheet1").Range("J" & NxtRw)
        End If
    Next Ws

End Sub

 

[Canoirode]

Thank you very much,

I came up with this solution ^^

Sub Canoirode()


Worksheets("Global").Range("A3:H1000").ClearContents
Worksheets("Global").Range("J3:K1000").ClearContents


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





For Each Ws In Worksheets
If Not Ws.Name = "Global" Then
NxtRw = Sheets("Global").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
UsdRws = Ws.Range("A3").End(xlDown).Row
Ws.Range("A3:G" & UsdRws).Copy Sheets("Global").Range("A" & NxtRw)
Ws.Range("J3:M" & UsdRws).Copy Sheets("Global").Range("J" & NxtRw)

End If
Next Ws





End Sub

Once again a big thank you :D