VBA Macro Копирование и вставка, вставка в отдельные местоположения

Question

Я пытаюсь написать макрос для копирования и вставки информации с одного листа на другой в зависимости от того, отмечена ли она как «Предстоящие/завершенные/в процессе» в столбце J на исходный лист (это называется «Tracker»). Это работает - но проблема в том, что он копирует всю строку из листа трекера, и я хочу, чтобы она копировала столбцы A: K. В идеале он публикует результаты в разных местах на Sheet1 в зависимости от статуса, но я всегда могу добавить другой макрос, чтобы сделать это потом! Должен признаться, я собираю существующий макрос, поскольку я немного слаб в VBA, так что это может быть частью проблемы. Большое спасибо, ребята.

Sub Copybasedonstatus() 
'Niall McCracken 12/12/16 

Dim lRow, cRow As Integer   
lRow = Sheets("Tracker").Range("A800").End(xlUp).Row 

For j = lRow To 1 Step -1  
    If Sheets("Tracker").Range("J" & j) = "Upcoming" Then 
     cRow = Sheets("Sheet1").Range("A800").End(xlUp).Row 
     Sheets("Tracker").Rows(j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1) 

    ElseIf Sheets("Tracker").Range("J" & j) = "Complete" Then 
     cRow = Sheets("Sheet1").Range("A800").End(xlUp).Row 
     Sheets("Tracker").Rows(j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1) 

    ElseIf Sheets("Tracker").Range("J" & j) = "In Progress" Then 
     cRow = Sheets("Sheet1").Range("A800").End(xlUp).Row 
     Sheets("Tracker").Rows(j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1) 

    End If 
Next 

End Sub 

Answer 1

xOnce вы решили, что (или где) вы хотите вставить скопированные строки (столбец А: К), дайте мне знать, и я могу изменить соответствующим образом.

Я использую инструкцию With Sheets("Tracker"), чтобы сделать код короче (также помогает уменьшить количество ошибок), также я заменил If s на Select Case .Range("J" & j).Value.

Примечание: нет необходимости в цикле назад, если вы не удаляете строки или ячейки. Вы можете использовать обычный For j = 1 To lRow, если хотите.

Код

Option Explicit 

Sub Copybasedonstatus() 

'Niall McCracken 12/12/16 

Dim lRow As Long, cRow As Long, j As Long 

With Sheets("Tracker") 
    lRow = .Range("A800").End(xlUp).Row 

    ' another method of finding last row in Column A (skipping blank cells in the middle) 
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row 

    For j = lRow To 1 Step -1 
     cRow = Sheets("Sheet1").Range("A800").End(xlUp).Row 

     Select Case .Range("J" & j).Value 
      Case "Upcoming" 
       .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1) 

      Case "Complete" 
       .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1) 

      Case "In Progress" 
       .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1) 

     End Select 
    Next 
End With 

End Sub