Copy rows from several sheets into one

Question

I'm trying to find and copy rows with "2019" from sheet1,2,3 etc to master sheet. How do i switch between sheets in that case? Can I use .For?

Sub Copy_To_Another_Sheet_1()
With Worksheets(1).Cells
  Set c = .Find("2019", LookIn:=xlValues, LookAt:=xlPart)
  If Not c Is Nothing Then
    firstResult = c.Address
    Do
      c.Select
      ActiveCell.EntireRow.Copy Destination:=Sheets(2).Range("A" & Rows.count).End(xlUp).Offset(1)
Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstResult
  End If
End With
End Sub

You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). You don't need to switch sheets if you don't us `.Select`. — Pᴇʜ, Jan 18 '19 at 09:42

score 0 · Answer 1 · answered Jan 18 '19 at 09:50

0

 Dim ws as worksheet
 For each ws in worksheets
   if ws.index <> 2 then 'ship second sheet because I think that's your master?
       set c = ws.find .... etc 

       if not c is nothing then
             firstResult = c.Address
            Do
                 c.entire.row.copy ....
                 set c = ws.findnext
            loop until...
        end if
      end if
      next ws

answered Jan 18 '19 at 09:50

Harassed Dad

4,669
1
10
12

First .find gives an error "method or data memeber not found". – Jenny Jan 18 '19 at 12:30

score 0 · Answer 2 · answered Jan 18 '19 at 10:45

You could try:

Option Explicit

Sub test()

    Dim ws As Worksheet
    Dim strSearch As String
    Dim rngSearch As Range
    Dim LastrowMaster As Long

    'Set what you are looking for
    strSearch = "2019"

    'Loop all sheets
    For Each ws In ThisWorkbook.Worksheets
        'Loop sheets except the master sheet
        If ws.Name <> "Master" Then

            'Set ws as search range & get the row
            Set rngSearch = ws.UsedRange.Find(strSearch)

            'Find master sheet lastrow
            LastrowMaster = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row

            'Paste the copied line in master sheet
            ws.Rows((rngSearch.Row)).EntireRow.Copy wsMaster.Range("A" & LastrowMaster + 1)

        End If

    Next

End Sub

score 0 · Answer 3 · answered Jan 18 '19 at 12:17

From All Sheets to Master Sheet

Array Version

Sub AllSheetsToMaster()

  Const cMaster As Variant = "Master"   ' Master Worksheet Name/Index
  Const cSearch As String = "2019"      ' Search String
  Const cFirstR As Long = 1             ' Source First Row Number
  Const cFirstC As Variant = 1          ' Source First Column Letter/Number

  Dim vntS As Variant   ' Source Array
  Dim vntC As Variant   ' Count Array
  Dim vntT As Variant   ' Target Array
  Dim LastUR As Long    ' Source Last Used Row Number
  Dim LastUC As Long    ' Source Last Used Column Number
  Dim LastR As Long     ' Target Last Used Row Number
  Dim x As Long         ' Worksheet Counter
  Dim i As Long         ' Source Array Row Counter
  Dim j As Long         ' Source/Target Array Column Counter
  Dim k As Long         ' Target Array Row Counter

  For x = 1 To ThisWorkbook.Worksheets.Count ' Worksheets

    ' From Source Worksheet to Source Array.

    With ThisWorkbook.Worksheets(x)
      ' Check if current worksheet name is th same as Master Worksheet Name.
      If .Name = cMaster Then GoTo NextWorksheet
      ' Check if current worksheet is empty.
      If .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , 1) _
          Is Nothing Then GoTo NextWorksheet
      ' Calculate Last Used Row and Column in current Source Worksheet.
      LastUR = .Cells.Find("*", , , , , 2).Row
      LastUC = .Cells.Find("*", , , , 2, 2).Column
      ' Copy current used range to Source Array.
      vntS = .Range(.Cells(cFirstR, cFirstC), .Cells(LastUR, LastUC))
    End With

    ' From Source Array to Count Array.

    ' Count Array cannot be bigger than Source Array.
    ReDim vntC(1 To UBound(vntS))
    k = 0 ' Reset Target Array Row Counter!!!
    For i = 1 To UBound(vntS) ' Rows
        For j = 1 To UBound(vntS, 2) ' Columns
            If vntS(i, j) = cSearch Then
                k = k + 1 ' Increase Target Array Row Counter.
                vntC(k) = i ' Write Source Array Row number to Count Array.
                Exit For ' Stop checking as soon as found.
            End If
        Next
    Next
    ReDim Preserve vntC(1 To k) ' Resize Count Array (make it smaller).

    ' From Source Array to Target Array.

    ' Resize Target Array to the Count Array rows and Source Array columns.
    ReDim vntT(1 To k, 1 To j)
    For i = 1 To k ' Rows
        For j = 1 To UBound(vntS, 2) ' Columns
            vntT(i, j) = vntS(vntC(i), j) ' Write to Target Array.
        Next
    Next

    ' From Target Array to Target Range.

    With ThisWorkbook.Worksheets(cMaster)
      ' Calculate Target Last Used Row Number.
      If Not .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , 1) _
              Is Nothing Then LastR = .Cells.Find("*", , , , , 2).Row
      ' Copy Target Array to Target Range.
      .Cells(LastR + 1, cFirstC).Resize(UBound(vntT), UBound(vntT, 2)) = vntT
    End With

NextWorksheet:
  Next

End Sub

Copy rows from several sheets into one

3 Answers3

From All Sheets to Master Sheet

Array Version