I'm trying to write a macro to copy and paste information from one sheet to another depending on whether it is marked as "Upcoming / Complete / In Progress" in column J on the original sheet (This is called the "Tracker"). It works - but the problem is that it is copying the whole row from the tracker sheet and I only want it to copy columns A:K. Ideally it would post the results to different places on Sheet1 depending on the status but I can always bodge another macro to do that afterwards! I must confess I'm hatcheting an existing macro as I'm a bit weak at VBA so that may be part of the problem. Many thanks guys.
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
xOnce you decide what (or where) you want to paste the copied rows (column A:K) , let me know and I can modify accordingly.
I use the With Sheets("Tracker")
statement to make the code shorter (also helps reduce bugs) , also I replaced your If
s with Select Case .Range("J" & j).Value
.
Note : there is no real need to loop backwards if you are not deleting rows or cells. You could use a regular For j = 1 To lRow
if you wanted.
Code
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.