VBA 从多个工作表中复制特定行，其名称包含“Hawk”并粘贴到新工作表中

Question

我有一个包含多个电子表格的工作簿。 其中一些电子表格的名称中包含“Hawk”一词。 例如，“12345 - HAWK”和“ABCDE - Hawk”。 我需要将这些工作表中的数据从第 38 行开始复制到 Hawk 工作表包含的多行，并将其粘贴到新的电子表格中。

我有从另一个线程获得的这段代码，但它只是粘贴了最后一张工作表中包含“Hawk”一词的行。 我需要它从包含“鹰”的名字，而不仅仅是最后一个EVERY片粘贴。

我没有任何 VBA 经验，所以我不确定出了什么问题。 任何建议将不胜感激。

Option Explicit

Sub compile()

  SelectSheets "Hawk", ThisWorkbook
 'Some other bits and pieces here

End Sub


Sub SelectSheets(sht As String, Optional wbk As Workbook)

Dim wks As Worksheet
Dim ArrWks() As String
Dim i As Long

If wbk Is Nothing Then Set wbk = ActiveWorkbook

ReDim ArrWks(0 To Worksheets.Count - 1)

For Each wks In Worksheets

    If InStr(1, wks.Name, sht) > 0 Then
        ArrWks(i) = wks.Name
        i = i + 1
    End If

Next wks

ReDim Preserve ArrWks(i - 1)

Dim ws As Long

For ws = LBound(ArrWks) To UBound(ArrWks)

    Worksheets(ArrWks(ws)).Range("A37:AC100").Copy
    Worksheets("VBA").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)

Next ws

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Answer 1

Public Sub compile()
Dim sh As Worksheet, lastrow As Long, lastcol As Long, i As Long
i = 1   'For paste data in first row in MasterSheet.
Sheets("MasterSheet").Cells.ClearContents   'Clear previous data.
For Each sh In ThisWorkbook.Worksheets
    If InStr(1, UCase(sh.Name), UCase("HAWK")) > 0 Then
        'IF your data is inconsistent then use find function to find lastrow an lastcol.
        lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
        lastcol = sh.Cells(38, Columns.Count).End(xlToLeft).Column
        'Here we collect data in master sheet.
        Sheets("MasterSheet").Range("A" & i).Resize(lastrow - 38 + 1, lastcol).Value = sh.Range("A38", sh.Cells(lastrow, lastcol)).Value
        i = i + lastrow - 38 + 1
    End If
Next sh
End Sub

使用这个而不是你的代码..它将收集从“A38”范围到最后一行和最后一列的所有数据并粘贴到母版表中..检查这个并让我知道它是否有效。