搜索工作簿中的項目A，如果找到，將行復制到工作簿B

Question

我需要基於搜索字符串從工作簿A複製到B.搜索部分似乎沒有問題，但複製不起作用。有什麼我做錯了嗎？

Set wbThis = ActiveWorkbook 
Set wsNewData = wbThis.Sheets("Sheet1") 
lNextRow = 1 
Set wbData = Application.Workbooks.Open(FileName, ReadOnly:=True) 
ThisWorkbook.Activate 
For Each ws In wbData.Worksheets 
With ws 
    For Each Cell In ws.Range("H:H") 
     If Cell.Value = fWhat Then 
      matchRow = Cell.Row 
      'ws.Rows("8:" & matchRow).Select 
      'Selection.Copy 
      ws.Rows(matchRow, "8").Copy wsNewData.Rows(lNextRow) 
      wsNewData.Select 
      wsNewData.Rows(lNextRow).Select 

      wsNewData.Paste 
      lNextRow = lNextRow + 1 
      wbThis.Save 
     End If 
    Next 
End With 
Next 
wbData.Close 

Answer 1

您的代碼在某些地方是多餘的。儘管我認爲最大的問題是貫穿整個色彩H的每個單元，這需要很長時間。下面是代碼，清理：

Set wbThis = ActiveWorkbook 
Set wsNewData = wbThis.Sheets("Sheet1") 
lNextRow = 1 
Set wbData = Application.Workbooks.Open(FileName, ReadOnly:=True) 
ThisWorkbook.Activate 
For Each ws In wbData.Worksheets 
    For Each Cell In intersect(ws.Range("H:H"),ws.usedrange) 
    If Cell.Value = fWhat Then 
     ws.Rows(Cell.Row).Copy wsNewData.Rows(lNextRow) 
     lNextRow = lNextRow + 1 
    End If 
    Next 
Next 
wbThis.Save 
wbData.Close 'you are closing this withouth saving. are you sure you want to do this???? just delete this line... 

的另一個問題是，顯然你在VBA真的初學者，在總體規劃。你爲什麼不從宏記錄器開始，並分析它記錄的代碼？另外，請閱讀一下面向對象編程和VBA。 對不起，但我不能解釋我所做的一切，我認爲我必須從亞當和夏娃開始...

希望這項工作。

此外，下一次，只要做一個自動過濾器，並用宏記錄器記錄它。甚至會比這更快。

Answer 2

它看起來像你到達那裏，但你有一些方法混合起來，副本似乎不清楚的來源和destinaton。

Dim wbThis As Workbook, wbData As Workbook 
Dim ws As Worksheet, wsNewData As Worksheet 
Dim cell As Range 
Dim lNextRow As Long, matchRow As Long 
Dim fWhat As String, fileName As String 

fWhat = "thing to find" 
fileName = Environ("TEMP") & Chr(92) & "myWorkBook.xlsb" 

Set wbThis = ActiveWorkbook 
Set wsNewData = wbThis.Sheets("Sheet1") 
Set wbData = Application.Workbooks.Open(fileName, ReadOnly:=True) 

lNextRow = 1 

For Each ws In wbData.Worksheets 
    With ws 
     For Each cell In Intersect(.UsedRange, .Range("H:H")) 
      If cell.Value = fWhat Then 
       matchRow = cell.Row 
       .Rows(matchRow).Copy wsNewData.Rows(lNextRow).Cells(1) 
       lNextRow = lNextRow + 1 
       wbThis.Save 
      End If 
     Next cell 
    End With 
Next ws 

wbData.Close SaveChanges:=False 
Set wbThis = Nothing 
Set wsNewData = Nothing 
Set wbData = Nothing 

我用從表一整行拷貝被檢查到wsNewData工作表（wbThis的Sheet）上的下一行。

當您處於With ... End With statement範圍內時，您不必繼續引用With ... End With參考。就在範圍/ .Rows等前面加上一段時間，他們就會知道父工作表是唯一被With ... End With引用的工作表。

我還不得不發明一個文件名和f尋找。你需要自己設置軟管。