Перенос данных из определенных столбцов в мастер-листе в несколько листов на основе условия - PullRequest
Новая
       17

Перенос данных из определенных столбцов в мастер-листе в несколько листов на основе условия

0 голосов
/ 25 октября 2018

Привет! Я хотел бы перенести данные из определенных столбцов в моей основной таблице на несколько рабочих листов на основе критериев. Вот код, который пока работает, но он очень трудоемкий.Есть ли способ изменить этот код и упростить добавление даты к 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
...