Below code (Code One) is currently working fine, where selected columns are copy & pasted with single criteria in Column A.
However, I am trying to add another condition, where excel will not copy cells if Columns N to R are blank. I tried writing Code Two (below) but getting Run-time error '9' Subscript out of Range.
Can I please get some assistance in changing Code Two so it will filter the columns correctly.
Code One
Dim i As Long
Dim iLastRow As Long
Dim iTarget As Long
With Worksheets("Okay")
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
If .Cells(i, "A").Value = "Welcome" Then
iTarget = iTarget + 1
.Cells(i, "B").Copy
Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "C").Copy
Worksheets("Sheet7").Range("B" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "D").Copy
Worksheets("Sheet7").Range("C" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "E").Copy
Worksheets("Sheet7").Range("D" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "F").Copy
Worksheets("Sheet7").Range("F" & iTarget + 1).PasteSpecial xlPasteValues
Worksheets("Sheet7").Range("G" & iTarget + 1).Value = "How"
Worksheets("Sheet7").Range("H" & iTarget + 1).Value = "Are"
Worksheets("Sheet7").Range("I" & iTarget + 1).Value = "You"
Worksheets("Sheet7").Range("J" & iTarget + 1).Value = "Okay"
.Cells(i, "N").Copy
Worksheets("Sheet7").Range("K" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "O").Copy
Worksheets("Sheet7").Range("L" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "P").Copy
Worksheets("Sheet7").Range("M" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "Q").Copy
Worksheets("Sheet7").Range("N" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "R").Copy
Worksheets("Sheet7").Range("O" & iTarget + 1).PasteSpecial xlPasteValues
End If
Next i
End With
Code Two
Dim i As Long
Dim iLastRow As Long
Dim iTarget As Long
With Worksheets("Okay")
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
If .Cells(i, "A").Value = "Welcome" Then
If .Cells(i, "N").Value <> "" Then
If .Cells(i, "O").Value <> "" Then
If .Cells(i, "P").Value <> "" Then
If .Cells(i, "Q").Value <> "" Then
If .Cells(i, "R").Value <> "" Then
iTarget = iTarget + 1
.Cells(i, "B").Copy
Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "C").Copy
Worksheets("Sheet7").Range("B" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "D").Copy
Worksheets("Sheet7").Range("C" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "E").Copy
Worksheets("Sheet7").Range("D" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "F").Copy
Worksheets("Sheet7").Range("F" & iTarget + 1).PasteSpecial xlPasteValues
Worksheets("Sheet7").Range("G" & iTarget + 1).Value = "Hello"
Worksheets("Sheet7").Range("H" & iTarget + 1).Value = "How"
Worksheets("Sheet7").Range("I" & iTarget + 1).Value = "Are"
Worksheets("Sheet7").Range("J" & iTarget + 1).Value = "You"
.Cells(i, "N").Copy
Worksheets("Sheet7").Range("K" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "O").Copy
Worksheets("Sheet7").Range("L" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "P").Copy
Worksheets("Sheet7").Range("M" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "Q").Copy
Worksheets("Sheet7").Range("N" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "R").Copy
Worksheets("Sheet7").Range("O" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "G").Copy
Worksheets("Sheet7").Range("P" & iTarget + 1).PasteSpecial xlPasteValues
End If
End If
End If
End If
End If
End If
Next i
End With
However, I am trying to add another condition, where excel will not copy cells if Columns N to R are blank. I tried writing Code Two (below) but getting Run-time error '9' Subscript out of Range.
Can I please get some assistance in changing Code Two so it will filter the columns correctly.
Code One
Dim i As Long
Dim iLastRow As Long
Dim iTarget As Long
With Worksheets("Okay")
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
If .Cells(i, "A").Value = "Welcome" Then
iTarget = iTarget + 1
.Cells(i, "B").Copy
Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "C").Copy
Worksheets("Sheet7").Range("B" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "D").Copy
Worksheets("Sheet7").Range("C" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "E").Copy
Worksheets("Sheet7").Range("D" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "F").Copy
Worksheets("Sheet7").Range("F" & iTarget + 1).PasteSpecial xlPasteValues
Worksheets("Sheet7").Range("G" & iTarget + 1).Value = "How"
Worksheets("Sheet7").Range("H" & iTarget + 1).Value = "Are"
Worksheets("Sheet7").Range("I" & iTarget + 1).Value = "You"
Worksheets("Sheet7").Range("J" & iTarget + 1).Value = "Okay"
.Cells(i, "N").Copy
Worksheets("Sheet7").Range("K" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "O").Copy
Worksheets("Sheet7").Range("L" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "P").Copy
Worksheets("Sheet7").Range("M" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "Q").Copy
Worksheets("Sheet7").Range("N" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "R").Copy
Worksheets("Sheet7").Range("O" & iTarget + 1).PasteSpecial xlPasteValues
End If
Next i
End With
Code Two
Dim i As Long
Dim iLastRow As Long
Dim iTarget As Long
With Worksheets("Okay")
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
If .Cells(i, "A").Value = "Welcome" Then
If .Cells(i, "N").Value <> "" Then
If .Cells(i, "O").Value <> "" Then
If .Cells(i, "P").Value <> "" Then
If .Cells(i, "Q").Value <> "" Then
If .Cells(i, "R").Value <> "" Then
iTarget = iTarget + 1
.Cells(i, "B").Copy
Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "C").Copy
Worksheets("Sheet7").Range("B" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "D").Copy
Worksheets("Sheet7").Range("C" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "E").Copy
Worksheets("Sheet7").Range("D" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "F").Copy
Worksheets("Sheet7").Range("F" & iTarget + 1).PasteSpecial xlPasteValues
Worksheets("Sheet7").Range("G" & iTarget + 1).Value = "Hello"
Worksheets("Sheet7").Range("H" & iTarget + 1).Value = "How"
Worksheets("Sheet7").Range("I" & iTarget + 1).Value = "Are"
Worksheets("Sheet7").Range("J" & iTarget + 1).Value = "You"
.Cells(i, "N").Copy
Worksheets("Sheet7").Range("K" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "O").Copy
Worksheets("Sheet7").Range("L" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "P").Copy
Worksheets("Sheet7").Range("M" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "Q").Copy
Worksheets("Sheet7").Range("N" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "R").Copy
Worksheets("Sheet7").Range("O" & iTarget + 1).PasteSpecial xlPasteValues
.Cells(i, "G").Copy
Worksheets("Sheet7").Range("P" & iTarget + 1).PasteSpecial xlPasteValues
End If
End If
End If
End If
End If
End If
Next i
End With