根据单元格值将特定行复制到另一个工作簿

Question

I want to copy row(A:E), row(F:AH), and row(AL)from the active workbook to row(A:E), row(G:AI), row(AJ) of another workbook. Here's the code that I'm working on. I saw it here and just edited it.

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim copyFrom As Range
Dim lRow As Long
Dim strSearch As String
Dim ret

ret = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls, .xlsx*),*.xls, .xlsx*", _
                                  Title:="Select data file for Monitoring Log")
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("Macro Template")

strSearch = "Newly Distributed"

With ws1

    .AutoFilterMode = False

    lRow = .Range("AL" & .Rows.Count).End(xlUp).Row

    With .Range("AL7:AL" & lRow)
        .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
        Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
    End With

    '~~> Remove any filters
    .AutoFilterMode = False
End With

'~~> Destination File
Set wb2 = Application.Workbooks.Open(ret)
Set ws2 = wb2.Worksheets("Source")

With ws2
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row + 1
    Else
        lRow = 1
    End If

    copyFrom.Copy .Rows(lRow)
End With

wb2.Save
wb2.Close

This code copies the entire row. How can I revise it to copy specific rows.

Answer 1

From the source code, i just could see you copy the data from the column AL to another worksheet.
I modified your code and it successfully copy to the another worksheet. The copy function could be written in 1 line instead of multiple line.

Option Explicit
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Dim strSearch As String

Sub Test()

Dim ret

ret = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls, .xlsx*),*.xls, .xlsx*", _
                                  Title:="Select data file for Monitoring Log")
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("Macro Template")

strSearch = "Newly Distributed"

With ws1

    .AutoFilterMode = False

    lRow = .Cells(Rows.Count, "AL").End(xlUp).Row
    'lRow = .Range("AL" & .Rows.Count).End(xlUp).Row

    With .Range("AL7:AL" & lRow)
        .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
    End With

End With

'~~> Destination File
Set wb2 = Application.Workbooks.Open(ret)
Set ws2 = wb2.Worksheets("Source")

With ws2
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lRow2 = .Cells(Rows.Count, "A").End(xlUp).Row
    Else
        lRow2 = 1
    End If

    'copyFrom.Copy .Rows(lRow)
    ws1.Range("AL8:AL" & lRow).SpecialCells(xlCellTypeVisible).Copy Destination:=ws2.Range("A" & lRow2)
End With

    '~~> Remove any filters
    ws1.AutoFilterMode = False

wb2.Save
wb2.Close
End Sub

Answer 2

Replace

copyFrom.Copy .Rows(lRow)

with

copyFrom.Columns("A:E").Copy .Cells(lRow, "A")
copyFrom.Columns("F:AH").Copy .Cells(lRow, "G")
copyFrom.Columns("AL").Copy .Cells(lRow, "AJ")