Question

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

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

这是我到目前为止所尝试的，但当我选择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

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

1 个答案: