如何在不打开文件的情况下访问文件并根据列中的文本复制行？

Question

下面的代码打开文件夹，让我选择我想作为源的文档，然后它在屏幕后面打开并在复制工作表时起作用。

[我试图更改代码以基于其中具有“ 140.保留”的G列复制行，然后将这些行的每一个粘贴到活动工作簿中。

更新的代码

Sub GetBIDFileCopyData()

Dim Fname As String
Dim SrcWbk As Workbook
Dim DestWbk As Workbook
Dim C As Range
Dim J As Long

Set DestWbk = ThisWorkbook

Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(Fname)

SrcWbk.Sheets("ChangeDetails").Rows(C.Row).Copy DestWbk.Sheets("Bids On-Hold 29.01.20").Rows(J)
J = 1
For Each C In SrcWbk.Range("G2:G200")
    If C.Value = "140. On Hold" Then
        J = J + 1
    End If
Next C

SrcWbk.Close False

End Sub

Answer 1

正如@SiddharthRout所评论的那样，基于特定条件复制/粘贴的最佳方法是使用过滤器。注释在下面的代码中给出。我没有测试您的代码来打开文件。

Dim Fname As String, SrcWbk As Workbook, DestWS As Worksheet, Rng As Range 'Assign your variables

    'Set your destination worksheet
    Set DestWS = ThisWorkbook.Sheets("Bids On-Hold 29.01.20")

    Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")

        If Fname = "False" Then Exit Sub

    Set SrcWbk = Workbooks.Open(Fname)

    'Set the range you want to filter on your scorce worksheet
    Set Rng = SrcWbk.Sheets("ChangeDetails").Range("G2:G200")

    'Since you used only column G for your range, use the copy line below.
    'But if you use the full range of the worksheet, e.g. Range("A1:Z200"),
    'you could use field:=7 in the filter, and remove .EntireRow from the copy line

        With Rng
            'Filter Column G
            .AutoFilter field:=1, Criteria1:="140. On Hold"
            'use Resize and Offset to copy the visible data
            'If Row 2 has data and is not a header row, you should use Row 1, in Rng
            'Offset and Resize adjusts the range so the top row(Header) is not copied
            Rng.Resize(Rng.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
            DestWS.Range("A1").PasteSpecial xlPasteValues

        'Clear the filter    
        .AutoFilter
        End With

Answer 2

两行

SrcWbk.Sheets ("ChangeDetails")
DestWbk.Sheets ("Bid Delivery Report")

不编译。他们应该怎么办？

您尝试使用以下代码复制行：

SrcWbk.Rows(C.Row).Copy DestWbk.Rows(J)

但是您缺少对工作表的引用。

所以也许您正在寻找：

    SrcWbk.Sheets("ChangeDetails").Rows(C.Row).Copy DestWbk.Sheets("Bid Delivery Report").Rows(J)

或更好地在表中使用变量。