Question

我正在尝试更改我的move under宏，以便在不同工作表的列下移动列。

当我在同一张纸上的其他列下移动列时，它工作正常。

我无法获得wsS.Range(Cells(2, j), Cells(lRow, j)).Copy _ Destination:=wsT.Range(Cells(LR, k), Cells(LR, k)).Offset(1, 0)

的正确语法

当我运行宏时，没有任何事情发生，不会抛出任何错误，也不会移动任何内容

由于

Sub MoveUnder()
Dim wsS As Excel.Worksheet
Dim wsT As Worksheet
Dim ar As Variant
Dim er As Variant
Dim i As Variant
Dim h As Variant
Dim j As Long
Dim k As Long
Dim lRow As Long
Dim LR As Long


Set wsS = ActiveWorkbook.Sheets(1)
Set wsT = ActiveWorkbook.Sheets(2)

    ar = Array("user id", "user name")    ' Find column to copy
    er = Array("user id", "user name")    ' Find column to paste beneith

lRow = wsS.Range("A" & Rows.count).End(xlUp).Row
LR = wsT.Range("A" & Rows.count).End(xlUp).Row

On Error Resume Next
For i = LBound(ar) To UBound(ar)
    j = wsS.Rows(1).Find(ar(i), Rows(1).Cells(Rows(1).Cells.count), , xlWhole,   xlByRows).Column
    k = wsT.Rows(1).Find(er(i), Rows(1).Cells(Rows(1).Cells.count), , xlWhole, xlByRows).Column

      wsS.Range(Cells(2, j), Cells(lRow, j)).Copy _
   Destination:=wsT.Range(Cells(LR, k), Cells(LR, k)).Offset(1, 0)
Next i
On Error GoTo 0

End Sub

Answer 1

我稍微修改了您的代码以便更可靠：

Sub MoveUnder()
    Dim wsS As Worksheet, wsT As Worksheet
    Dim ar, er, i, h, j, k
    Dim lRow As Long, LR As Long
    Dim rng1 As Range, rng2 As Range

    Set wsS = ActiveWorkbook.Sheets(1)
    Set wsT = ActiveWorkbook.Sheets(2)

    ar = Array("user id", "user name")    ' Find column to copy
    er = Array("user id", "user name")    ' Find column to paste beneith

    lRow = wsS.Range("A" & wsS.Rows.Count).End(xlUp).Row
    LR = wsT.Range("A" & wsT.Rows.Count).End(xlUp).Row

    For i = LBound(ar) To UBound(ar)
        Set rng1 = wsS.Range("1:1").Find(ar(i), wsS.Cells(1, wsS.Columns.Count), , xlWhole, xlByRows)
        Set rng2 = wsT.Range("1:1").Find(er(i), wsT.Cells(1, wsT.Columns.Count), , xlWhole, xlByRows)
        If Not rng1 Is Nothing And Not rng2 Is Nothing Then
            j = rng1.Column
            k = rng2.Column

            wsS.Range(wsS.Cells(2, j), wsS.Cells(lRow, j)).Copy _
                Destination:=wsT.Cells(LR + 1, k)
        End If
    Next i
End Sub

您应该完全符合Cells这样的对象：wsT.Cells(LR, k)等等。

另请查看此链接以获取解释Why I should use On Error Resume Next judiciously

当改变为在纸张之间移动时，移动Marco下不工作

1 个答案: