在特定列中的所有工作表中搜索特定文本并粘贴到另一个工作表

Question

我对 vba 很陌生，所以我搜索了这个主题，虽然我发现了类似的问题，但我仍然很难理解这些公式，所以我希望有人能提供帮助。

我想在我的工作簿的所有工作表的 B 列中搜索其文本中包含“光盘”的任何单元格。然后，我想复制并粘贴所在行中的所有信息，或者如果不是整行，至少是 B 和 C 列中的信息。

这是我迄今为止尝试过的，但是当我选择 B:B 时，它选择的是我的“光盘”工作表上的列，而不是它应该循环的工作表。

Sub DiscFill()
 '
 '
 ' Keyboard Shortcut: Ctrl+Shift+D
   Dim DiscsSh As Worksheet
    Dim sh As Worksheet
    Dim I As Integer

'add new sheet at the end'
Set DiscsSh = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'rename it'
DiscsSh.Name = "Discs"

 'loop through all sheets'
 For Each sh In Worksheets
    'if sh is not Discs sheet, then'
     If sh.Name <> DiscsSh.Name Then


'Select Column Range and Search for Discs
Columns("B:B").Select

Cells.Find(What:="Component Discs", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Select

'Finds Row from Search and Adds 1 to start in the correct Row/sku#
startRow = Selection.Row + 1
'Go back to new sheet to start inputing data
Sheets("Discs").Select

'this tells you how far you can potentially go
For j = startRow To 999
        'if blank cell then the loop stops
        If Sheets(I).Cells(j, 3).Value = "" Then
        Exit For
    Else
                mat_num = Sheets(I).Cells(j, 3).Value
                TitleDescrip = Sheets(I).Cells(j, 2).Value
                Cells(counter, 1).Value = mat_num
                Cells(counter, 2).Value = TitleDescrip
                counter = counter + 1
        End If
Next j

    End If
Next

 End Sub

Answer 1

嗨@SDension 修改代码希望这能工作

提及工作表 obj。

  sh.Columns("B:B").Select

 sh.Cells.Find(What:="Component Discs", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Select