VBA Copy Range instead of entire row

[floggingmolly]

I have the VBA code below that copies the row if the word Invite is found in column AC. Is there a way to have it only copy columns A - AA? Columns AB and AC are helper columns with formulas so I don't need them pasted into the other workbook. Any help would be greatly appreciated.

Sub CopyRowsWithInvite()
    Dim sourceWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim targetWorkbook As Workbook
    Dim targetWorksheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetRow As Long
    
    ' Set the file path and name of the source workbook
    Dim sourceFilePath As String
    sourceFilePath = "C:\SERVICE PROVIDER FAMILIARIZATION REPORT\SP FAM 2 NEG PULLED.xlsx"
    
    ' Set the name of the source worksheet
    Dim sourceSheetName As String
    sourceSheetName = "sheet1"
    
    ' Set the name of the target workbook
    Dim targetFilePath As String
    targetFilePath = "C:\SERVICE PROVIDER FAMILIARIZATION REPORT\Fam daily report updated.xlsx"
    
    ' Set the name of the target worksheet
    Dim targetSheetName As String
    targetSheetName = "Master Ph 2" ' Change to the desired sheet name
    
    ' Open the source workbook
    Set sourceWorkbook = Workbooks.Open(sourceFilePath)
    Set sourceWorksheet = sourceWorkbook.Worksheets(sourceSheetName)
    
    ' Set the last row of data in column AC of the source worksheet
    lastRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, "A").End(xlUp).Row
    
    ' Open the target workbook
    Set targetWorkbook = Workbooks.Open(targetFilePath)
    Set targetWorksheet = targetWorkbook.Worksheets(targetSheetName)
    
    ' Start copying rows to the target worksheet from the first row
    targetRow = 3
    
    ' Loop through each row in the source worksheet
    For i = 3 To lastRow
        ' Check if the cell in column AC contains the word "INVITE"
        If InStr(1, sourceWorksheet.Cells(i, "AC").Value, "INVITE", vbTextCompare) > 0 Then
            ' Copy the entire row to the target worksheet
            lastRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, "A").End(xlUp).Row + 1 ' Change "A" to the appropriate column letter

sourceWorksheet.Rows(i).Copy targetWorksheet.Rows(lastRow)

lastRow = lastRow + 1
             ' Move to the next row in the target worksheet
        End If
    Next i
    
    ' Save and close the target workbook
    targetWorkbook.Save
    
    
   
    
    ' Release the memory
    Set sourceWorksheet = Nothing
    Set sourceWorkbook = Nothing
    Set targetWorksheet = Nothing
    Set targetWorkbook = Nothing
    
    MsgBox "Rows containing 'INVITE' in column AC have been copied to the target workbook.", vbInformation
End Sub
[\code]

 

[Joe4]

Try changing this line:

sourceWorksheet.Rows(i).Copy targetWorksheet.Rows(lastRow)

to this:

sourceWorksheet.Range("A" & i & ":AA" & i).Copy targetWorksheet.Range("A" & lastRow)

 

[floggingmolly]

Try changing this line:

sourceWorksheet.Rows(i).Copy targetWorksheet.Rows(lastRow)

to this:

sourceWorksheet.Range("A" & i & ":AA" & i).Copy targetWorksheet.Range("A" & lastRow)

This worked perfectly. Thank you so much. I appreciate the quick response.

 

[Joe4]

You are welcome.

Note: In the future, when marking a response as the solution, please mark the original post containing the solution, not your own post acknowledging that another post was the solution.
I have updated this thread for you.