how do I copy same columns which are laterally placed from different worksheets into a single worksheet?

Question

I have 50 worksheets in a workbook. columns a,b,c,d are same as columns e,f,g,h, but both sets might have different number of rows/observations. I need to consolidate all in a single sheet having only 3 columns. I need to append the column names, start copying and pasting (values) from 3rd row onwards (till end of data). I tried recording a macro too but in that case, I have to go through all the sheets manually. Can someone lead me to the right direction? I'm very new to VBA and a little help will be much appreciated. My recorded macro for copying 2 sheets goes like this:

Sheets("page 9").Select
Range("A3:D3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets.Add After:=Sheets(Sheets.Count)
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlDown).Select
Range("A67").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 9").Select
Range("E3:H3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlDown).Select
Range("A132").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 10").Select
Range("A65").Select
Selection.End(xlUp).Select
Range("A3:D3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlDown).Select
Range("A197").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 10").Select
Range("E3:H3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlUp).Select
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Type"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Size"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Discount"
Range("A1").Select
 End Sub

Tony Dallimore Tony Dallimore · Accepted Answer · 2014-01-26T11:33:14

I doubt that anyone can decypher this code; certainly I lack the ability.

The Macro recorder is a great way of learning the syntax of new commands but it does not produce "good" code. It does not know your objective and records every little step as you do it.

Take the time to study Excel VBA. Search the internet for "Excel VBA Tutorial" or visit a good library or bookshop and select an Excel VBA Primer. There are many to chose from so I am sure you will find something that suits your learning style. This study will quickly repay your investment.

Look through the excel-vba questions on StackOverflow. Many, perhaps most, will be of no current interest to you. But some will show techniques you did not know about but which will be useful. Perhaps the most difficult aspect of learning VBA is discovering what is possible. Once you know statement X exists, you can look it up and study its syntax and functionality.

Below are four macros that demonstrate relevant code. Copy them to a workbook and try them. You could not have learnt how to write these macros from a study of macro recorder output.

A This macro outputs the name of every worksheet to the Immediate Window.

Sub A()

  Dim InxWsht As Long

  For InxWsht = 1 To Worksheets.Count
    Debug.Print Worksheets(InxWsht).Name
  Next

End Sub

B This adds a new worksheet at the end of the current list and names it "Consolidate". It then creates a bold, coloured header line.

Range(CellId).Value is one way of accessing a cell's value. I have used "A1" as the cells's Id but this is just a string and could have been built at runtime. Cells(RowId, ColId).Value is another way. RowId must be a number or an integer variable. ColId can be a number, an integer variable or a column letter. I suggest you be consistent and not mix and match as I have.

I show two method of specifying a range so I can set the entire header row bold and coloured in single statements.

If I have written Range("A1").Value = "Date" this statement would have operated on cell A1 of the active worksheet. The . before Range means this statement operates of cell A1 of the worksheet identified in the With statement. Using With means I do not have to switch worksheets using Select which is a slow command.

Sub B()

  Dim WhshtCons As Worksheet

  Set WhshtCons = Sheets.Add(After:=Sheets(Sheets.Count))

  WhshtCons.Name = "Consolidate"

  With WhshtCons

    .Range("A1").Value = "Date"
    .Cells(1, 2).Value = "Type"
    .Cells(1, "C").Value = "Size"
    .Cells(1, 4).Value = "Discount"

    .Range("A1:D1").Font.Bold = True
    .Range(.Cells(1, 1), .Cells(1, "D")).Font.Color = RGB(0, 128, 128)

  End With

End Sub

C This outputs the value of Cell A1 of every worksheet except "Consolidate".

Sub C()

  Dim InxWsht As Long

  For InxWsht = 1 To Worksheets.Count
    If Worksheets(InxWsht).Name <> "Consolidate" Then
      With Worksheets(InxWsht)
        Debug.Print "Cell A1 of Worksheet " & .Name & " contains [" & _
                    .Cells(1, 1).Value & "]"
      End With
    End If
  Next

End Sub

D I will not explain this macro because it is somewhat more advanced than the others. It demonstrates moving columns of data from all the other worksheets to worksheet "Consolidate". I doubt this is close to what you seek but it demonstrates that what you seek is possible.

Sub D()

  Dim ColConsCrnt As Long
  Dim InxWsht As Long
  Dim RowLast As Long
  Dim WhshtCons As Worksheet

  ColConsCrnt = 1

  Set WhshtCons = Worksheets("Consolidate")
  WhshtCons.Cells.EntireRow.Delete

  For InxWsht = 1 To Worksheets.Count
    If Worksheets(InxWsht).Name <> "Consolidate" Then
      With Worksheets(InxWsht)
        RowLast = .Cells(Rows.Count, "A").End(xlUp).Row
        WhshtCons.Cells(1, ColConsCrnt).Value = .Name
        .Range(.Cells(1, "A"), .Cells(RowLast, "A")).Copy _
                            Destination:=WhshtCons.Cells(2, ColConsCrnt)
      End With
      ColConsCrnt = ColConsCrnt + 1
    End If
  Next

End Sub

Welcome to programming. I hope you find it as much fun as I do.

how do I copy same columns which are laterally placed from different worksheets into a single worksheet?

1 Answers