Macro to combine multiple sheets into one

[nkustura]

Hi,

I am in a desparate need of a macro. I have an excell spreadhseet that has more than 100 sheets and I would like to combine all these sheets into one master sheet (Sheet1 = MasterSheet) within this workbook. Each sheet has different number of rows used. I just want used ranges to be copied over to a master file appending the previous copied range. I have started a macro and I am kind of stuck. Please help!

Sub MergeSheets()

Dim strSheet As Object
Dim LR As Long, LC As Long
Sheets("Sheet1").Name = "MasterSheet"
LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
For Each strSheet In Sheets
If strSheet.Index <> 1 Then
LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
LC = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Range(Cells(1, 1), Cells(LR, LC)).Copy Destination:=Sheets("MasterSheet").Cells(LR + 1, 1)
End If
Next strSheet

End Sub

Thanks a lot. All help is greatly appreciated.

-Nermina

 

[VoG]

How dos t6his not work?

 

[olympiac]

Try this:

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

 

[nkustura]

This macro works for the most part, but it is not including all used cells on some of the sheets. I noticed if ex. column M is blank, but columns N & O have data in few rows, the macro only selects/copies data up to column M. So I need it it to look at last row and last column with data and copy all of it.

Thank you so much for your help.

-Nermina

 

[VoG]

Try

Sub MergeSheets()
Dim strSheet As Object
Dim LR As Long, LC As Long
Sheets("Sheet1").Name = "MasterSheet"
For Each strSheet In Sheets
    If strSheet.Index <> 1 Then
        With strSheet
            LR = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
            LC = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
            .Range(Cells(1, 1), Cells(LR, LC)).Copy Destination:=Sheets("MasterSheet").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End With
    End If
Next strSheet
End Sub

 

[Karthik-Excelsior]

Hi Olympiac,

Your code seems to work only when the sheets are named 'sheet1,' sheet2, and so on. What to do in case of differently named sheets?