VBA从多个工作表中复制名称包含“鹰”的特定行，然后粘贴到新工作表中

问题描述

我有一个包含多个电子表格的工作簿。其中一些电子表格的名称中包含单词“ Hawk”。例如，“ 12345-HAWK”和“ ABCDE-Hawk”。我需要从第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

解决方法

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”到最后一行和最后一列的所有数据，并粘贴到母版表中。检查并让我知道它是否有效。

excel excel spreadsheet