Question

嗨，我想根据条件将数据从主表中的特定列传输到多个工作表中到目前为止，这里是代码，它可以正常工作，但是非常耗时。有没有一种方法可以修改此代码，并使添加日期到30个以上的工作表中更加简单。

Sub copycolumns()

Dim i, LastRow
Dim j, LastRow1
Dim erow As Long

    LastRow = Worksheets("Master").Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To LastRow
        If Worksheets("Master").Cells(i, "J").Value = "Amanda" Then
        Worksheets("Master").Cells(i, 1).Copy
         erow = Worksheets("AmPaid").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("Master").Paste Destination:=Worksheets("AmPaid").Cells(erow, 1)

Worksheets("Master").Cells(i, 3).Copy
Worksheets("Master").Paste Destination:=Worksheets("AmPaid").Cells(erow, 2)

Worksheets("Master").Cells(i, 5).Copy
Worksheets("Master").Paste Destination:=Worksheets("AmPaid").Cells(erow, 3)
End If

Next i

      LastRow1 = Worksheets("Master").Range("A" & Rows.Count).End(xlUp).Row
    For j = 2 To LastRow
        If Worksheets("Master").Cells(j, "J").Value = "John" Then
        Worksheets("Master").Cells(j, 1).Copy
         erow = Worksheets("JhPaid").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("Master").Paste Destination:=Worksheets("JhPaid").Cells(erow, 1)

Worksheets("Master").Cells(j, 3).Copy
Worksheets("Master").Paste Destination:=Worksheets("JhPaid").Cells(erow, 2)

Worksheets("Master").Cells(j, 5).Copy
Worksheets("Master").Paste Destination:=Worksheets("JhPAid").Cells(erow, 3)
End If

Next j

End Sub

根据条件将数据从母版表中的特定列转移到多个工作表

0 个答案: