查找工作薄所有表包含xx文字的单元格，并将那行复制到新工作博中

book1688

大佬们麻烦帮忙看看，测试了以下代码，发现代码运行无误但新工作薄中是空白的，没任何内容
Sub CopyRowsWithDesignText()
    Dim ws As Worksheet
    Dim newWb As Workbook
    Dim targetRange As Range

    'Create a new workbook
    Set newWb = Workbooks.Add

    'Loop through each worksheet
    For Each ws In ThisWorkbook.Worksheets
        'Find the last row in the worksheet
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

        'Loop through each row in the worksheet
        For i = 1 To lastRow
            If InStr(ws.Cells(i, 1), "设计") > 0 Then
                'If "设计" is found in the current row, copy the entire row to the new workbook
                If targetRange Is Nothing Then
                    Set targetRange = ws.Rows(i)
                Else
                    Set targetRange = Union(targetRange, ws.Rows(i))
                End If
            End If
        Next i
    Next ws

    'Copy the target range to the new workbook
    If Not targetRange Is Nothing Then
        targetRange.Copy
        newWb.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    End If
End Sub

陆离Lowry

cells（i，1）第一列不是序号吗？？

陆离Lowry

。。。。。。。。。。。

book1688

陆离Lowry 发表于 2023-1-30 18:58
。。。。。。。。。。。

看到了，学习学习

gwjkkkkk

Sub test()
    Dim ar, br, i&, j&, iCol&, wks As Worksheet
   
    ReDim br(1 To 10000, 1 To 32)
   
    With Sheets(1)
    iCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To iCol
       br(1, i) = .Cells(1, i)
    Next i
    End With
    r = 1
    For Each wks In Worksheets
       With wks
           ar = .[A1].CurrentRegion
           For i = 1 To UBound(ar)
              If InStr(ar(i, 13), "设计") Then
                 r = r + 1
                 For j = 1 To 32
                    br(r, j) = ar(i, j)
                 Next j
              End If
           Next i
       End With
    Next wks
   
    If r > 1 Then
        With Workbooks.Add
            With .Sheets(1).[A1].Resize(r, 32)
               .Value = br
               .HorizontalAlignment = xlCenter
               .Borders.LineStyle = xlContinuous
               .Rows(1).Font.Bold = True
               '.EntireColumn.AutoFit
               .EntireRow.AutoFit
            End With
        End With
    End If
    Beep
End Sub

shiruiqiang

book1688 发表于 2023-1-30 19:26
看到了，学习学习

建议关键字做成变量

gwjkkkkk

参与一下。。。