简体   繁体   中英

VBA Copy specific rows from multiple sheets with their names containing “Hawk” and paste into new sheet

I have a workbook containing multiple spreadsheets. Some of these spreadsheets contain the word "Hawk" in their name. For instance, "12345 - HAWK" and "ABCDE - Hawk". I need to copy data from these sheets starting from row 38 down to however many rows that Hawk sheet contains and paste this into a new spreadsheet.

I have this code that I got from another thread, but it is only pasting the rows from the last sheet that contains the word "Hawk". I need it to paste from EVERY sheet that contains "Hawk" in the name, not just the last one.

I don't have any experience in VBA, so I'm not sure what is going wrong. Any advice would be greatly appreciated.

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

Use this one instead of your code..It will collect all the data from range "A38" to last row and column and paste in mastersheet..Check this and let me know if it works.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM