combined data from a sheet after a specified sheet

[KlausW]

Hi

I'm using this VBA code to merge multiple sheets into one sheet, but I can't get it to run.
What it has to do is add up all sheets after sheet number 6. In to the sheet Vare.
The area to be combined is from A2:I and until there is no more text.
And it must be inserted in sheet Vare from A2 and down.
Some who can help

Any help will be appreciated

Best regards

Klaus W

Sub Rektangelafrundedehjørner7_Klik()

'UpdatebyExtendoffice

Dim J As Integer

On Error Resume Next

Sheets(1).Select

'Worksheets.Add

Sheets(1).Name = "Vare"

Sheets(4).Activate

Range("A2:I").EntireRow.Select

Selection.Copy Destination:=Sheets(1).Range("A2")

For J = 4 To Sheets.Count

Sheets(J).Activate

Range("A1:I").Select

Selection.CurrentRegion.Select

Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)

Next

'Column_Width

End Sub

 

[RobP]

Hi there,

when you say "add up all sheets after sheet 6" - I assume you mean copy all the data from the sheet onto the bottom of sheet1 (VARE).
This code copies all the data from sheet(4) onwards - but you can amend that.

The danger here is if you run it twice, its going to copy everything twice onto the VARE sheet - but hopefully you can build on it from there.

Sub Rektangelafrundedehjørner7_Klik()

Dim J As Integer

Sheets(1).Select
Sheets(1).Name = "Vare"

varelastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'use col 1 to check for bottom row


For J = 4 To Sheets.Count

Sheets(J).Activate

sheetlastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'use col A to check for bottom row of data
ActiveSheet.Range("A1", "I" & sheetlastrow).Copy

Sheets(1).Select
ActiveSheet.Paste Destination:=Worksheets("Vare").Range("A" & varelastrow + 1, "I" & varelastrow + sheetlastrow)
  
varelastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'Reset last row on VARE as new data was pasted.

Next

 

[KlausW]

Hi there,

when you say "add up all sheets after sheet 6" - I assume you mean copy all the data from the sheet onto the bottom of sheet1 (VARE).
This code copies all the data from sheet(4) onwards - but you can amend that.

The danger here is if you run it twice, its going to copy everything twice onto the VARE sheet - but hopefully you can build on it from there.

Sub Rektangelafrundedehjørner7_Klik()

Dim J As Integer

Sheets(1).Select
Sheets(1).Name = "Vare"

varelastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'use col 1 to check for bottom row


For J = 4 To Sheets.Count

Sheets(J).Activate

sheetlastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'use col A to check for bottom row of data
ActiveSheet.Range("A1", "I" & sheetlastrow).Copy

Sheets(1).Select
ActiveSheet.Paste Destination:=Worksheets("Vare").Range("A" & varelastrow + 1, "I" & varelastrow + sheetlastrow)
 
varelastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'Reset last row on VARE as new data was pasted.

Next

Thank I look at it an return

 

[KlausW]

Good Morning, Yes that's what I want, to copy all data from a2 and down, on all sheets after sheets 6. How do I change which sheet I want to start copying? How do I change if I want to copy from A9? Thanks for the information about double copying . Best Regards Klaus W

 

[RobP]

Hi Klaus,

ok, so on this line, you can see I go from 4 to the last worksheet in the book, whatever that may be. Simply change the start number from 4 to 6.

For J = 4 To Sheets.Count

.. and amazingly, where you see "A1" here, you can change it to "A9".

ActiveSheet.Range("A1", "I" & sheetlastrow).Copy

Good luck.
(and apologies, I realised I forgot to paste the "End Sub" at the end of my code in my initial post. You'll need that.

Rob

 

[KlausW]

Hi Klaus,

ok, so on this line, you can see I go from 4 to the last worksheet in the book, whatever that may be. Simply change the start number from 4 to 6.

For J = 4 To Sheets.Count

.. and amazingly, where you see "A1" here, you can change it to "A9".

ActiveSheet.Range("A1", "I" & sheetlastrow).Copy

Good luck.
(and apologies, I realised I forgot to paste the "End Sub" at the end of my code in my initial post. You'll need that.

Rob

Good morning RobP many thanks for your great help. It was just as it should be.
Good weekend
Best regards from Denmark
Klaus W

 

[RobP]

Great, glad it helped.

Thanks for the feedback.

Cheers
Rob