Excel VBA: combine multiple worksheets into one

Question

I use the following code to combine multiple worksheets. The problem is, that this code works with worksheets that have title in the first row and my worksheets do not have. It is possible to select only 3 columns (A, F and G).. I mean the range from the woorksheets? The worksheets have the same structure only the number of lines may be different. Any idea? Thanks!

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
    Sheets(J).Activate ' make the sheet active
    Range("A1").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
    ' copy cells selected in the new sheet on last line
    Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

Note: Remove `On Error Resume Next`! It hides **all** error messages but the errors still occur, you just cannot see them. It's like closing your eyes. Errors that you cannot see cannot be fixed! • You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — Pᴇʜ, Jan 21 '19 at 11:19
Also it is very unclear what you are actually asking. Please be more clear, probably screenshots might help to explain what you are trying to do. — Pᴇʜ, Jan 21 '19 at 11:26
For example: I have 3 Sheets: A, B and C. Sheet A has data between rows 1 and 2, B between 1 and 3 and C only on row 1. Column with data are A,B....G. I just want to create another sheet (Combined) that contains the data from A,B,C... in the example 6 rows. And I would like to copy only row F and G in the new combined sheet. — Vasilescu Catalin, Jan 21 '19 at 11:38
`Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select` this part is what you'll need to look at, currently all of the rows are selected. You haven't said where the row numbers are coming from per sheet, or shown your own attempts. None of the selection is really needed either. — Nathan_Sav, Jan 21 '19 at 12:08
@Nathan_Sav in fact, i can delete this line and nothing happen. I don't know the number of the rows, each sheet have a different number. I mean, the number of the rows may differ quite a bit. With the code from above the "bombined" file contains only the first row from each sheet, not all the rows. Any idea how cand a resolv this thing? — Vasilescu Catalin, Jan 21 '19 at 12:21

simple-solution · Accepted Answer · 2019-01-21T13:09:16.043

Instead of copying only A, F+G you can delete all columns you don't need from the resulting sheet.

Sub Combine()
Dim jCt As Integer
Dim ws As Worksheets
Dim myRange As Range
Dim lastRow As Long
lastRow = 1

'Delete Worksheet combine if it exists
If sheetExists("Combined") Then
    Application.DisplayAlerts = False
    Sheets("Combined").Delete
    Application.DisplayAlerts = True
    MsgBox "Worksheet ""Combined"" deleted!"
End If

Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"

' work through sheets
For jCt = 2 To Sheets.Count ' from sheet 2 to last sheet

    Set myRange = Sheets(jCt).Range(Sheets(jCt).Cells(1, 1), Sheets(jCt).Range("A1").SpecialCells(xlCellTypeLastCell))
    Debug.Print Sheets(jCt).Name, myRange.Address

    'Put the SheetName on the Sheet "Cominbed"
    Sheets("Combined").Range("A1").Offset(lastRow, 0) = Sheets(jCt).Name
    With Sheets("Combined").Range("A1").Offset(lastRow, 0).Font
        .Bold = True
        .Size = 14
    End With

    'copy the sheets
    myRange.Copy Destination:=Sheets("Combined").Range("A1").Offset(lastRow + 2, 0)
    lastRow = lastRow + myRange.Rows.Count + 3

Next
End Sub


Function sheetExists(sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function

Excel VBA: combine multiple worksheets into one

1 Answers1

Linked