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

Canoirode

New Member
Joined
Sep 10, 2014
Messages
10
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... :confused:

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
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
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
 
Upvote 0
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
Code:
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
 
Upvote 0
Out of curiosity, how would you specify two ranges in your script?

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

Thanks a million anyway
 
Upvote 0
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
 
Upvote 0
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
Code:
    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
Code:
    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
 
Last edited:
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top