stackoom
  简体   繁体   中英

Excel VBA macro with a For loop

 原文  2018-11-07 09:01:57  1   1    excel/ vba

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?

1 answers

solution1
 0 ACCPTED  2018-11-07 09:33:52

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.
eg 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

暂无
暂无

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

Related Question Excel Macro VBA for loop? Excel For Loop VBA Macro not working Excel VBA Macro - Concatenating in a Loop Creating a Loop in VBA Macro for Excel? Complicated Excel VBA Macro with Loop Excel VBA: Macro not Identifying the For in the Loop creating a loop in vba for an excel macro For Each Loop Ranges VBA Excel Macro Optimizing loop for vba macro excel 2007 Excel VBA Macro delete row infinite loop
Related Tags
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM