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

Question

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

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

我在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

使用这个而不是您的code..It将收集从"A38“范围到最后一行和列的所有数据，并粘贴到mastersheet..Check中，并让我知道它是否有效。