在VBA中将不相邻的列移动到相邻的行

Question

我正在尝试移动一些不相邻的数据列并转置到另一个选项卡中的相邻行。我正在使用下面的 For Each 循环执行此操作，但它在第二次迭代时因“运行时错误 1004：范围类的选择方法失败”而中断，位于

c.select

。为什么？

Sub move_scores_to_final()
'
' move_scores_to_final Macro
'

'
    Sheets("analysis worksheet").Select
    Range("A1").Select
    
    Dim Rng7 As Range
    Set Rng7 = FindAll(Range("1:1"), "Adjusted Score", xlValues, xlPart, , True)
    
    Rng7.Select
    
    Dim c As Range, sel As Range, i As Integer
    i = 1
    Set sel = Selection
    
    For Each c In sel.Cells
        c.Select
        c.Offset(1, 0).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("final worksheet").Select
        Range("A1").Offset(i, 12).Select 'this is to make the rows adjacent and i need to put the data starting in column 12
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        i = i + 1
    Next c

End Sub

Answer 1

也许像这样：

Sub move_scores_to_final()

    Dim Rng7 As Range, wsAnalysis As Worksheet, wsFinal As Worksheet
    Dim c As Range, i As Long
    
    Set wsAnalysis = Worksheets("analysis worksheet")
    Set wsFinal = Worksheets("final worksheet")
    
    Set Rng7 = FindAll(wsAnalysis.Rows(1), "Adjusted Score", xlValues, xlPart, , True)
    
    i = 1
    For Each c In Rng7.Cells
        wsAnalysis.Range(c.Offset(1), wsAnalysis.Cells(Rows.Count, c.Column).End(xlUp)).Copy
        
        wsFinal.Range("M1").Offset(i).PasteSpecial _
                 Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        i = i + 1
    Next c

End Sub