VBA Help

[danny8890]

Hi Guys,

Could you assist me with the below please,
I want to just copy rows A:F when column A contains the word SSN. at the moment it copys the entire row, cannot figure this one out.

Private Sub Workbook_Open2()


Dim i, LastRow


LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Sheets("Sheet1").Cells(i, "A").Value Like "*SIM*" Then
Sheets("Sheet1").Cells(i, "A").EntireRow.Copy Destination:=Sheets("SIM").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
For i = 2 To LastRow
If Sheets("Sheet1").Cells(i, "A").Value Like "*SSN*" Then
Sheets("Sheet1").Cells(i, "A").EntireRow.Copy Destination:=Sheets("SIM").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i


End Sub

Thanks

 

[danny8890]

When contains SSN & SIM

 

[offthelip]

try this:

Private Sub Workbook_Open2()



Dim i, LastRow




LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Sheets("Sheet1").Cells(i, "A").Value Like "*SIM*" Then
Sheets("Sheet1").Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Sheets("SIM").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
For i = 2 To LastRow
If Sheets("Sheet1").Cells(i, "A").Value Like "*SSN*" Then
Sheets("Sheet1").Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Sheets("SIM").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i




End Sub

 

[danny8890]

try this:

Private Sub Workbook_Open2()



Dim i, LastRow




LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Sheets("Sheet1").Cells(i, "A").Value Like "*SIM*" Then
Sheets("Sheet1").Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Sheets("SIM").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
For i = 2 To LastRow
If Sheets("Sheet1").Cells(i, "A").Value Like "*SSN*" Then
Sheets("Sheet1").Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Sheets("SIM").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i




End Sub

Hi, thanks for quick response, i have tried this and getting error message "run time error 1004" which is what i keep getting when try to get it to work.

 

[Fluff]

Hi & welcome to the board.
How about

Private Sub Workbook_Open2()

   Dim i, LastRow
   
   LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
   For i = 2 To LastRow
      If Sheets("Sheet1").Cells(i, "A").Value Like "*SIM*" Then
         Sheets("Sheet1").Range("A" & i).Resize(, 6).Copy Destination:=Sheets("SIM").Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next i
   For i = 2 To LastRow
      If Sheets("Sheet1").Cells(i, "A").Value Like "*SSN*" Then
         Sheets("Sheet1").Range("A" & i).Resize(, 6).Copy Destination:=Sheets("SIM").Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next i

End Sub

If it doesn't matter if the SSn & SIM are mixed up, another option would be

Private Sub Workbook_Open2()

   Dim i, LastRow
   
   With Sheets("Sheet1")
      LastRow = .Range("A" & Rows.Count).End(xlUp).Row
      For i = 2 To LastRow
         If .Cells(i, "A").Value Like "*SIM*" Or Cells(i, "A").Value Like "*SSN*" Then
            .Range("A" & i).Resize(, 6).Copy Destination:=Sheets("SIM").Range("A" & Rows.Count).End(xlUp).Offset(1)
         End If
      Next i
   End With

End Sub