VBA 复制和粘贴范围

Question

我有一个代码，可以根据工作表 1 列中的单元格值将行从工作表 1 复制并粘贴到工作表 2。表 1 有 20 多列，但我只需要表 2 中的 5 列。是否有更好的方法来编写此代码，以便我可以为不同的单元格值复制此代码并粘贴部分代码？也就是说，我有 5 行代码，我想减少到 1 行。我想在 Sheet 2 上创建多个相互偏移的表。列是固定的，行是可变的。目前，我必须重复代码并准确指定表 2 中的放置位置。

For myRow = 1 To LastRow

If (Sheets("Sheet1").Cells(myRow, "E") = "TI002768E2XA E005") Then
    Set srcRange = Sheets("Sheet1").Cells(myRow, "F").Resize(1, 5)
    If Application.CountA(srcRange) = 5 Then
        Sheets("Sheet2").Cells(myCopyRow, "B") = Sheets("Sheet1").Cells(myRow, "E")
        Sheets("Sheet2").Cells(myCopyRow, "C") = Sheets("Sheet1").Cells(myRow, "D")
        Sheets("Sheet2").Cells(myCopyRow, "D") = Sheets("Sheet1").Cells(myRow, "F")
        Sheets("Sheet2").Cells(myCopyRow, "E") = Sheets("Sheet1").Cells(myRow, "G")
        Sheets("Sheet2").Cells(myCopyRow, "F") = Sheets("Sheet1").Cells(myRow, "H")
        myCopyRow = myCopyRow + 1
    
    End If
    
End If 
If (Sheets("Sheet1").Cells(myRow, "E") = "TI002768E2XA E105") Then
    Set srcRange = Sheets("Sheet1").Cells(myRow, "F").Resize(1, 5)
    If Application.CountA(srcRange) = 5 Then
        Sheets("Sheet2").Cells(myCopyRow1, "H") = Sheets("Sheet1").Cells(myRow, "E")
        Sheets("Sheet2").Cells(myCopyRow1, "I") = Sheets("Sheet1").Cells(myRow, "D")
        Sheets("Sheet2").Cells(myCopyRow1, "J") = Sheets("Sheet1").Cells(myRow, "F")
        Sheets("Sheet2").Cells(myCopyRow1, "K") = Sheets("Sheet1").Cells(myRow, "G")
        Sheets("Sheet2").Cells(myCopyRow1, "L") = Sheets("Sheet1").Cells(myRow, "H")
        myCopyRow1 = myCopyRow1 + 1
    
    End If
    
End If

Next myRow

Answer 1

我将使用源列和目标列的数组。然后，使用循环复制每列的值。例如，复制的第一部分应如下所示；

Dim srcColumns() As Variant
Dim destColumns() As Variant
Dim i As Integer

For myRow = 1 To LastRow

    If Sheets("Sheet1").Cells(myRow, "E") = "TI002768E2XA E005" Then
        Set srcRange = Sheets("Sheet1").Cells(myRow, "F").Resize(1, 5)
        If Application.CountA(srcRange) = 5 Then
            srcColumns = Array("E", "D", "F", "G", "H")
            destColumns = Array("B", "C", "D", "E", "F")
            
            For i = LBound(srcColumns) To UBound(srcColumns)
                Sheets("Sheet2").Cells(myCopyRow, destColumns(i)).Value = Sheets("Sheet1").Cells(myRow, srcColumns(i)).Value
            Next i
            
            myCopyRow = myCopyRow + 1
        End If
    End If