CODEWITHSUNDEEP
vbaexcelspreadsheet
Carol.Kar
Carol.Kar

Reputation: 5215

Combine sheets into one sheet horizontally

I would like to merge all worksheets in a workbook below each other.

My current code looks like the following:

Sub Combine()
    Dim J As Integer
    On Error Resume Next
    Sheets(1).SelectWorksheets.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).ActivateRange("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

However, my current output is:

http://www.tiikoni.com/tis/view/?id=60ce910

For this example I have three sheets and they look like the following:

http://www.tiikoni.com/tis/view/?id=e96939e

All these sheets look like the same.

My desired output should look like that:

Desired Output

Any suggestion what I am doing wrong?

I appreciate your answer!

Upvotes: 0

Views: 1153

Answers (1)

Etheur
Etheur

Reputation: 347

I wrote this up and it seems to work well enough. It assumes that you'll always be copying from the same range in each sheet (set in the strRange variable). I was using range A2:A10 in my test, but you can change it to be something like A2:T10 depending on how far out your data goes. It also assumes you already have a "Combined" sheet as your Sheet1.

Sub combineSheets()

Dim rngPaste As Range 'range to paste to
Dim rngCopy As Range 'range to copy from

Dim strRange As String 'range in sheets to copy from
strRange = "A2:A10"

Set rngPaste = ActiveWorkbook.Worksheets("Combined").Range(strRange) 'initial range to paste into

Dim s As Integer
For s = 2 To Sheets.Count

    Set rngCopy = ActiveWorkbook.Worksheets(s).Range(strRange) 'copy from same range in each sheet

    rngPaste.Value = rngCopy.Value 'copy values into first sheet

    Set rngPaste = rngPaste.Offset(10, 0) 'moves paste range for next copy

Next s

End Sub

As for why your code in particular doesn't work, it seems to be just copying in the same data from Sheet2 each time it iterates, so it might just not be changing its selection each time you move to a new sheet. I haven't used straight selections in a while so I can't tell which part is causing it, but that can be circumvented by copying the data more directly with something like the rngPaste.Value = rngCopy.Value above.

Upvotes: 1

Related Questions