Excel VBA macro with a For loop

Question

I used the following macro which I know is horrible to look at but I was not good enough to integrate a loop in the code so I repeated it.

However, I now need to increase the number of copied columns to 96 and I think it would be much nicer to have a loop...

Here is the current code:

Sub Transpose()   
' Transpose Macro
'    
'
    Application.ScreenUpdating = False
    Sheets("HiddenSheet").Visible = True
    Sheets("Hiddensheet").Select
    Range("A64:T584").Select
    Selection.ClearContents

    Sheets("Hiddensheet").Select
    Range("B2:P61").Select
    Selection.Copy
    Range("A64").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A64:BH78").Select
    Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
    SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
    ReplaceFormat:=False

    Range("A64:BH78").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp

    Sheets("Hiddensheet").Select
    Range("B64:B78").Select
    Selection.Copy
    Range("A63").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("C64:C78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("D64:D78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("E64:E78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("F64:F78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("G64:G78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("H64:H78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("I64:I78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("J64:J78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("K64:K78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("L64:L78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("M64:M78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("N64:N78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("O64:O78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("P64:P78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("Q64:Q78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("R64:R78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("S64:S78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("T64:T78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("U64:U78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("V64:V78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("W64:W78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("X64:X78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("Y64:Y78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("Z64:Z78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AA64:AA78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AB64:AB78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AC64:AC78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AD64:AD78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AE64:AE78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AF64:AF78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AG64:AG78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AH64:AH78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AI64:AI78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AJ64:AJ78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AK64:AK78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AL64:AL78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AM64:AM78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AN64:AN78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AO64:AO78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AP64:AP78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AQ64:AQ78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AR64:AR78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AS64:AS78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AT64:AT78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AU64:AU78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AV64:AV78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AW64:AW78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AX64:AX78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AY64:AY78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("AZ64:AZ78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("BA64:BA78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("BB64:BB78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("BC64:BC78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("BD64:BD78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("BE64:BE78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("BF64:BF78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("BG64:BG78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Sheets("Hiddensheet").Select
    Range("BH64:BH78").Select
    Selection.Copy
    Range("A64").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste

    Range("A44").End(xlDown).Select
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(252, _
        213, 180)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(216, _
        228, 188)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(230, _
        184, 183)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, _
        255, 0)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(184, _
        204, 228)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(204, _
        192, 218)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(196, _
        189, 151)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(217, _
        217, 217)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
        255, 0)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
        192, 0)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(146, _
        208, 80)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, _
    176, 80)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, _
    176, 240)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
    0, 0)
    ActiveWorkbook.Worksheets("Hiddensheet").Sort.SortFields.Add(Range("A24").End(xlDown), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(112, _
    48, 160)

    With ActiveWorkbook.Worksheets("Hiddensheet").Sort
        .SetRange Range("A64:A963")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Sheets("Hiddensheet").Select
    Range("A64:A159").Select
    Selection.Copy
    Sheets("Import").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("Import").Select
    Range("A2:F97").Select
    ActiveWorkbook.Worksheets("Import").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Import").Sort.SortFields.Add Key:=Range("A2:A97") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Import").Sort
        .SetRange Range("A2:T97")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1:A97").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:F").Select
    Cells.EntireColumn.AutoFit


    Sheets("HiddenSheet").Visible = False

I need to repeat the part that copies the next column and pastes it at the bottom of the A column 95 times, I would really appreciate some help on the loop.

How could I go about this?

Welcome to Stack Overflow! Other users marked your question for low quality and need for improvement. I re-worded/formatted your input to make it easier to read/understand. Please review my changes to ensure they reflect your intentions. Feel free to drop me a comment in case you have further questions or feedback for me. — GhostCat, Nov 07 '18 at 09:46
I recommend to read [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Pᴇʜ, Nov 07 '18 at 10:51

Darren Bartrup-Cook · Accepted Answer · 2018-11-07T10:55:19.810

This will copy the columns to the bottom of column A. Just adjust the value that x steps through - currently goes from B to CR.

Edit: I've updated the code to include the other parts in your code. I'm not sure how you're deciding on some ranges so I've left those as is rather than finding the end of the various ranges.
e.g. do you always clear A64:T584 or is it variable?

Public Sub Transpose()

    Dim x As Long
    Dim rLastCell As Range
    Dim shtHidden As Worksheet
    Dim shtImport As Worksheet

    Set shtHidden = ThisWorkbook.Worksheets("HiddenSheet")
    Set shtImport = ThisWorkbook.Worksheets("Import")

    With shtHidden
        .Visible = xlSheetVisible

        .Range("A64:T584").ClearContents
        .Range("B2:P61").Copy
        .Range("A64").PasteSpecial xlPasteValues
        With .Range("A64:BH78")
            .Replace What:="0", Replacement:="", _
                LookAt:=xlWhole, SearchOrder:=xlByRows
            .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        End With

        For x = 2 To 96 'Adjust to column numbers you want to copy.
            Set rLastCell = .Cells(Rows.Count, 1).End(xlUp) 'Last cell containing data in column 1.
            .Range(.Cells(64, x), .Cells(78, x)).Copy 'Copy rows 64:78 of column "x".
            rLastCell.Offset(1).PasteSpecial xlPasteValues 'Paste values to end of column A.
        Next x

        Set rLastCell = .Cells(Rows.Count, 1).End(xlUp)

        'You seem to be sorting on colour here and then value.  Not sure - so only sorted on value.
        With .Sort
            With .SortFields
                .Clear
                .Add Key:=shtHidden.Range(shtHidden.Cells(64, 1), rLastCell), _
                     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With

            .SetRange shtHidden.Range(shtHidden.Cells(64, 1), rLastCell)
            .Header = xlNo 'Or xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            '.SortMethod = xlPinYin 'Something to do with Chinese alphabet, so not needed.
            .Apply
        End With

        'No need to PasteSpecial Values as that was done when copying into column A.
        .Range(.Cells(64, 1), rLastCell).Copy Destination:=ThisWorkbook.Worksheets("Import").Range("C2")

    End With

    With shtImport
        With .Sort
            With .SortFields
                .Clear
                .Add Key:=shtImport.Range("A2:A97"), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With
            .SetRange shtImport.Range("A2:T97")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With
        .Range("A1:A97").Delete Shift:=xlToLeft
        .Columns("A:F").AutoFit
    End With

    shtHidden.Visible = xlSheetHidden 'or xlSheetVeryHidden

End Sub

Thank you Darren. I used the code you first posted and edited it to fit the appropriate ranges, it works great and I will definitely re-use it for other macros. The color sorting was intended as I am using a conditional formatting which allows me to differentiate variables. — Sylvain.A, Nov 07 '18 at 14:59
Good stuff. The first set of code is still in there - just padded it out with the other code. If it's helped feel free to tick the accepted answer next to the answer. :) — Darren Bartrup-Cook, Nov 07 '18 at 15:01

Excel VBA macro with a For loop

1 Answers1