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

从源代码中，我可以看到您将数据从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

Answer 2

替换

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")

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

2 个答案: