Copy Multiple Worksheet contents

[BakerBaker]

Thanks in advance.
This is a copy of part of worksheet 1 which is a horse racing rating method:

Horse

Satchville Flyer

Irish Times

Red Cossack (CAN)

Kellington Kitty (USA)

Pass The Cristal (IRE)

<tbody>
[TD="class: xl65"] Chelmsford City 16.45 (in cell A1)[/TD]
[TD="class: xl66, width: 64"][/TD]

[TD="class: xl67"]Points[/TD]

[TD="class: xl67"]233[/TD]

[TD="class: xl67"]177[/TD]

[TD="class: xl67"]174[/TD]

[TD="class: xl67"]143[/TD]

[TD="class: xl67"]138[/TD]

</tbody>

On each day I can have up to 20 worksheets set out the same but with a different header in A1 (the next worksheet has Chelmsford City 17.15). I do have a macro which combines each worksheet into a single sheet called "Combined" but it will only insert cell A1 from the first sheet with all other A1 cells from other sheets being omitted thus:

Horse

Satchville Flyer

Irish Times

Red Cossack (CAN)

Kellington Kitty (USA)

Pass The Cristal (IRE)

<tbody>
[TD="class: xl65"] Chelmsford City 16.45 [/TD]
[TD="class: xl66, width: 64"][/TD]

[TD="class: xl67"]Points[/TD]

[TD="class: xl67"]233[/TD]

[TD="class: xl67"]177[/TD]

[TD="class: xl67"]174[/TD]

[TD="class: xl67"]143[/TD]

[TD="class: xl67"]138[/TD]

</tbody>

Horse

Blue Harmony

Pindaric

Swiss Cross

Magicinthemaking (USA)

Mochalov

<tbody>
[TD="class: xl65, width: 64"]Points [/TD]

[TD="class: xl65"]247[/TD]

[TD="class: xl65"]246[/TD]

[TD="class: xl65"]242[/TD]

[TD="class: xl65"]200[/TD]

[TD="class: xl65"]200[/TD]

</tbody>

In the above example there should be "Chelmsford City 17.15" from worksheet 2, cell A1 in a row above "Horse" which would give a separation to each set of ratings

This is the macro I am using:

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").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
End Sub

Any assistance in achieving my desired result would be appreciated.

 

[Exceladd1ct]

What happens if you change the Offset row property from your code to zero?

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

 

[BakerBaker]

That does exactly what I want to achieve! Thank you very much for your prompt reply.

 

[Exceladd1ct]

Glad to help.

 

[Fluff]

How about

Sub BakerBaker()
   Dim Sht As Long
   
   Sheets.Add(Sheets(1)).Name = "Combined"
   For Sht = 2 To Sheets.Count
      Sheets(Sht).Range("A1").CurrentRegion.Copy Range("A" & Rows.Count).End(xlUp).Offset(1)
   Next Sht
   Range("A1").EntireRow.Delete
End Sub

 

[BakerBaker]

Thanks. Got a run-time error 1004. "That name is already taken. Try a different one." On debug - Sheets.Add(Sheets(1)).Name="Combined" is highlighted.
However, the previous answer worked OK and am using.

 

[Fluff]

Fair enough.
For anyone looking at this in the future, the error is because a sheet called Combined already exists.

 

[BakerBaker]

Thanks "Fluff". The existing "Combined" sheet was generated by the previous macro. Deleting that sheet and running your script actually produces a better result; I hadn't noticed, but the previous macro actually omits the very last row of each record. Thanks again.

 

[Fluff]

You're welcome & thanks for the feedback