Question

我想按标题名称将所选列移到粘贴到从A列开始的连续列的新页面

My Macro仅移动最后一列

由于

Sub MoveColumnsToNewSheet()
Dim ar As Variant
Dim i As Variant
Dim j As Long
Dim LR As Long

Sheets(1).Select

    ar = Array("user name", "Label")     ' Find column to copy

LR = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
For i = LBound(ar) To UBound(ar)
    j = Rows(1).Find(ar(i), Rows(1).Cells(Rows(1).Cells.Count), , xlWhole, xlByRows).Column

      Range(Cells(1, j), Cells(LR, j)).Copy _
      Destination:=Worksheets(2).Columns(i)
Next i
On Error GoTo 0

End Sub

Answer 1

主要问题是LBound数组的Variant将为0，因此Columns(i)将在第一个循环中失败。我认为而不仅仅是'＃34;只移动最后一列＆＃34;它没有移动第一个 - 只有两列的微妙区别。

如果您的On Error语句跨越较少的代码，则会更容易发现。您只需要Find语句。

另请注意，您需要每次将j重置为0，然后通过测试确定是否找到了某些内容是否仍为0。

最后，请使用工作表名称限定所有范围，行等。我在这里使用With语句来减少重复性：

Sub MoveColumnsToNewSheet()
Dim wsSource As Excel.Worksheet
Dim wsTarget As Excel.Worksheet
Dim ar As Variant
Dim i As Variant
Dim j As Long
Dim LR As Long

Set wsSource = ThisWorkbook.Worksheets(1)
Set wsTarget = ThisWorkbook.Worksheets(2)
ar = Array("user name", "Label")     ' Find column to copy

With wsSource
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = LBound(ar) To UBound(ar)
        On Error Resume Next
        j = 0
        j = .Rows(1).Find(ar(i), .Rows(1).Cells(.Rows(1).Cells.Count), , xlWhole, xlByRows).Column
        On Error GoTo 0
        If j <> 0 Then
            .Range(.Cells(1, j), .Cells(LR, j)).Copy _
                    Destination:=wsTarget.Columns(i + 1)
        End If
    Next i
End With

最后，最后，我鼓励比ar更有意义的变量名称。当这段代码增长并且时间过去之后，你会说什么？＃＆＃34;

将列移动到新工作表的宏仅移动最后一列

1 个答案: