Combine Sheet VBA Coding Error - Help Please

[boilermaker1997]

I've modified some VBA code that I want to use to combine the content of 7 worksheets in a workbook. The worksheets are named "BVCZ2", "BVET", "BVIMA", "BVISI", "CCEDC", "CHINA", "PTBV". When I run the VBA code, it copies the content from the first worksheet (BVCZ2) 7 times rather than moving to the next. Could someone please help me with the error in my coding?

Coding as follows:

Sub Combine2()
Dim J As Worksheet

On Error Resume Next

' copy headings
Sheets("BVCZ2").Activate
Range("A4").EntireRow.Select
'Selection.Copy Destination:=Sheets(1).Range("A1")
Selection.Copy Destination:=Sheets("Combined").Range("A1")

' work through sheets
For Each J In ActiveWorkbook.Sheets(Array("BVCZ2", "BVET", "BVIMA", "BVISI", "CCEDC", "CHINA", "PTBV"))
Sheets(J).Activate ' make the sheet active
Range("A4").Select
Selection.CurrentRegion.Select ' select all cells in this sheets

' select all lines except title
'Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Offset(4, 0).Resize(Selection.Rows.Count - 1).Select

' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets("combined").Range("A65536").End(xlUp)(2)
Next
End Sub

 

[VoG]

Try removing

On Error Resume Next

I think you'll find you've mis-spelled a sheet name.

 

[boilermaker1997]

When I remove the On Error Resume Next line, I get a Run-Time Error 13 Type Mismatch error.

The line "Sheets(J).Activate ' make the sheet active" is highlighted when I debug.


Which sheet name do you believe is mis-spelled? I'm not spotting it.

 

[VoG]

Sorry but I have no idea. Try removing them one at a time from your Array declaration.

 

[boilermaker1997]

So nothing else looks wrong? What I mean is the logic sound for the coding?

 

[jvanbonn]

Here's what I have so far. Maybe someone can figure out why I can't get COPY to work.

Sub Combine2()
Dim J As Variant
Dim Rng As Range
Dim ws As Variant

ws = Array("BVCZ2", "BVET", "BVIMA", "BVISI", "CCEDC", "CHINA", "PTBV")
'On Error Resume Next

' copy headings
Sheets(ws(0)).Range("A4").EntireRow.Copy Destination:=Sheets("Combined").Range("A1")

' work through sheets
For Each J In ws
Set Rng = Worksheets(J).Range("A4").CurrentRegion ' select all cells in this sheets
[I][COLOR=Red]Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, Rng.Columns.Count).Copy _
Destination:=Worksheets("Combined").Cells(Rows.Count, 1).End(xlUp) + 1[/COLOR][/I]

Debug.Print Rng.Address

Next J
End Sub

 

[boilermaker1997]

So does your code go to the individual sheets, but it just doesn't select the current region?

 

[jvanbonn]

My idea was to define the range (Rng) of each sheet and copy the Rng, less the header info, to the "Combined" sheet.

There is no need to actually "Select" a sheet or range to copy it. We just have to define the range and the destination.

 

[VoG]

Surely just

For Each J In ActiveWorkbook.Sheets(Array("BVCZ2", "BVET", "BVIMA", "BVISI", "CCEDC", "CHINA", "PTBV"))
J.Activate ' make the sheet active

 

[boilermaker1997]

That worked!! Thanks for your help.