具有For循环的Excel VBA宏

Question

我使用了下面的宏，我知道这很可怕，但是我不足以将循环集成到代码中，所以我重复了一下。

但是，我现在需要将复制的列数增加到96，我认为有一个循环会更好...

这是当前代码：

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

我需要重复复制下一列并将其粘贴到A列底部95次的部分，我非常感谢您对循环的帮助。

我该怎么办？

Answer 1

这会将列复制到A列的底部。只需调整x所经过的值-当前从B到CR。

编辑：我已经更新了代码，以将其他部分包括在您的代码中。我不确定您是如何确定某些范围的，所以我将这些保留为原样，而不是找到各个范围的终点。
例如，您是否总是清除A64:T584还是可变的？

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