JohChris01
12-10-2015, 10:48 AM
Hello,
I have a worksheet that I am copy rows to multiple worksheets based on multiple criteria. I started with the code to copy to one worksheet (Mens) from the master data sheet (Formatted Data). I am trying to use an If statement within a loop.
In Column A to copy only if criteria matches 10, 15, or 17 and
In column B copy row only if criteria does NOT match string "By Season" or "By Divisi".
The first set of criteria works just find but I can not get it to exclude the rows with the second criteria
Sub PasteDataToWorksheets()'
'Shortcut Key = Cntrl + Shift + W
'
Dim LastRow As Long
Dim i As Long, j As Long
'Find the last used row in a Column: column A in this example
With Worksheets("Formatted Data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'first row number where you need to paste values in Mens'
With Worksheets("Mens")
j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
For i = 1 To LastRow
With Worksheets("Formatted Data")
If .Cells(i, 1).Value = 10 Or .Cells(i, 1).Value = 15 Or .Cells(i, 1).Value = 17 Then
If .Cells(i, 2).Value <> "BY SEASON" Or .Cells(i, 2).Value <> "BY DIVISI" Then
.Rows(i).Copy Destination:=Worksheets("Mens").Range("A" & j)
j = j + 1
End If
End If
End With
Next i
MsgBox "Macro is Complete"
End Sub
I have a worksheet that I am copy rows to multiple worksheets based on multiple criteria. I started with the code to copy to one worksheet (Mens) from the master data sheet (Formatted Data). I am trying to use an If statement within a loop.
In Column A to copy only if criteria matches 10, 15, or 17 and
In column B copy row only if criteria does NOT match string "By Season" or "By Divisi".
The first set of criteria works just find but I can not get it to exclude the rows with the second criteria
Sub PasteDataToWorksheets()'
'Shortcut Key = Cntrl + Shift + W
'
Dim LastRow As Long
Dim i As Long, j As Long
'Find the last used row in a Column: column A in this example
With Worksheets("Formatted Data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'first row number where you need to paste values in Mens'
With Worksheets("Mens")
j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
For i = 1 To LastRow
With Worksheets("Formatted Data")
If .Cells(i, 1).Value = 10 Or .Cells(i, 1).Value = 15 Or .Cells(i, 1).Value = 17 Then
If .Cells(i, 2).Value <> "BY SEASON" Or .Cells(i, 2).Value <> "BY DIVISI" Then
.Rows(i).Copy Destination:=Worksheets("Mens").Range("A" & j)
j = j + 1
End If
End If
End With
Next i
MsgBox "Macro is Complete"
End Sub