CODEWITHSUNDEEP
vbaexcel
John Callender
John Callender

Reputation: 3

Combine sheets in excel

I have a workbook that has 50 plus sheets in it. What I am looking to do is to combine all the sheets into 1 master sheet with the following criteria: 1. Each sheet in its own column 2. The sheet name as the header of that column

Each sheet has one column (A) with data in it but various amount of rows. There are no headers in the sheets. From my research I have found that I can combine all the sheets into 1 column, but that does not help. Any help would be appreciated and thank you

Upvotes: 0

Views: 2519

Answers (3)

user2930684
user2930684

Reputation: 1

This may help

Option Explicit
Sub CopyRangePaste()
    'copies and pastes what is required
    Dim wshResult As Worksheet
    Dim wsh As Worksheet
    Dim msg As String ' alert message
    Dim iCounter As Integer
    If Worksheets.Count < 2 Then 'if there is only 1 worksheet exits sub
        msg = "There is only 1 worksheet." & vbCrLf
        msg = msg & "Try again with a different workbook."
        MsgBox msg, vbCritical
        Exit Sub
    End If
    Set wshResult = ActiveWorkbook.Sheets.Add
    iCounter = 0
    For Each wsh In ActiveWorkbook.Worksheets
        If wsh.Name <> wshResult.Name Then 'checks if the newly created sheet is not operated on
            iCounter = iCounter + 1
            wshResult.Cells(1, iCounter) = wsh.Name
            wsh.Range(wsh.UsedRange.Find("*").CurrentRegion.Address).Copy _
                      wshResult.Cells(2, iCounter) 'copies the current region
        End If
    Next wsh
    MsgBox iCounter & " sheets"
End Sub

Upvotes: 0

JNevill
JNevill

Reputation: 50019

This is a little ugly but it will do what you want. Just change Set targetWS = Sheets("Sheet1") to be the sheet that you are putting all the data. 

Sub combineSheets()
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim targetCol As Integer
    Dim endRow As Long

    'This is the sheet where the data will end up
    Set targetWs = Sheets("Sheet1")

    'This is the first column to start pasting into
    targetCol = 1

    'Loop through the worksheets in the workbook
    For Each sourceWs In ThisWorkbook.Worksheets

        'grab the data from each sheet, bu not the target sheet
        If sourceWs.Name <> targetWs.Name Then

            'find last row in source sheet
            endRow = sourceWs.Range("A999999").End(xlUp).Row()

            'paste data and name
            targetWs.Range(targetWs.Cells(2, targetCol), targetWs.Cells(endRow, targetCol)) = sourceWs.Range("A1:A" & endRow).Value
            targetWs.Cells(1, targetCol).Value = sourceWs.Name

            'next column
            targetCol = targetCol + 1
        End If
    Next sourceWs
End Sub

Upvotes: 0

Lifewithsun
Lifewithsun

Reputation: 998

Try this: 

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

It will help you..

Upvotes: 1

Related Questions