Скопируйте определенную строку в другую книгу на основе значения ячейки

Question

Я хочу скопировать строку (A: E), строку (F: AH) и строку (AL) из активной книги в строку (A: E), строку (G: AI), строка (AJ) другой книги. Вот код, над которым я работаю. Я видел его здесь и только что редактировал.

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 

Этот код копирует всю строку. Как я могу пересмотреть его для копирования определенных строк.

Answer 1

Заменить

copyFrom.Copy .Rows(lRow) 

с

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

Answer 2

Из исходного кода я просто мог видеть, как вы копируете данные из столбца AL на другой рабочий лист.
Я изменил ваш код и успешно скопировал его на другой рабочий лист. Функция копирования может быть записана в 1 строке вместо нескольких строк.

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