如果单元格满足条件，则将给定行中的选定列（不在范围内，不在相邻列中）复制到另一张工作表（按给定顺序）

Question

我在Sheet1上有很多行。如果单元格满足条件（当前行和A列中的单元格满足条件），我想将一行的某些列（而不是整个行，而不是列的范围）复制到Sheet2（到Sheet2的第一个空行） y的值）我不想复制Sheet1的整个行，而只复制Sheet3（A列）上给出的那些具有列的行，并且Sheet3（B列）上也给出新的列号（Sheet2上）

如果我的任务是复制整个行，或者所选的列在一个范围内，那将很简单...但是我需要复制Sheet3上专门的那些列。我将不胜感激。预先感谢。

Sheet1显示示例数据表。条件是如果Cells（Rows，1）.Value =“ y”Sheet2显示了所需的结果。Sheet3在Sheet1上显示选定的列号，在Sheet2上显示新的列号

Answer 1

虽然这可能应该更多地使用数组来完成，但是这里是一些基本的VBA代码，该代码循环了第一张工作表以检查第一列中的“ y”。找到它后，它将循环第三张表中已保存到数组中的列映射以设置第二张表中的值：

Sub sTranasferData()
    On Error GoTo E_Handle
    Dim aOld() As Variant
    Dim aNew() As Variant
    Dim wsIn As Worksheet
    Dim wsOut As Worksheet
    Dim wsTrack As Worksheet
    Dim lngLastRow As Long
    Dim lngLoop1 As Long
    Dim lngLoop2 As Long
    Dim lngRow As Long
    Dim lngTrack As Long
    Set wsIn = Worksheets("Sheet1")
    Set wsOut = Worksheets("Sheet2")
    Set wsTrack = Worksheets("Sheet3")
    lngLastRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row
    lngTrack = wsTrack.Cells(wsTrack.Rows.Count, "A").End(xlUp).Row
    aOld() = wsTrack.Range("A2:A" & lngTrack).Value
    aNew() = wsTrack.Range("B2:B" & lngTrack).Value
    lngRow = 1
    For lngLoop1 = 2 To lngLastRow
        If wsIn.Cells(lngLoop1, 1) = "y" Then
            For lngLoop2 = LBound(aOld) To UBound(aOld)
                wsOut.Cells(lngRow, aNew(lngLoop2, 1)) = wsIn.Cells(lngLoop1, aOld(lngLoop2, 1))
            Next lngLoop2
            lngRow = lngRow + 1
        End If
    Next lngLoop1
sExit:
    On Error Resume Next
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set wsTrack = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sTransferData", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

问候，