CODEWITHSUNDEEP
excelvba
gtrain
gtrain

Reputation: 11

How to copy rows between worksheets based on a text value

I am trying to copy an entire row from one worksheet to another worksheet based on the occurrence of a specific text value ("Yes") in column H of the row.

I found this code and would like to change it to search through multiple sheets in the workbook. I've read about using an array, but I'm not sure how to implement it.

It doesn't need to examine the first 1000 rows if that needs to be changed, the whole sheet is fine.

Thank you.

Sub CopyYes()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Jan 19")
    Set Target = ActiveWorkbook.Worksheets("Storage")

    J = 1     ' Start copying to row 1 in target sheet
    For Each c In Source.Range("H1:H1000")   ' Do 1000 rows
        If c = "yes" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c
End Sub

Upvotes: 1

Views: 159

Answers (1)

Damian
Damian

Reputation: 5174

I would just filter your range and then copy the filtered data like this:

Option Explicit
Sub CopyYes()

    Dim LastRow As Long, Col As Long, Lrow As Long
    Dim Source As Worksheet, Target As Worksheet
    Dim arrws
    Dim HandleIt As Variant

    ' Change worksheet designations as needed
    Set Target = ThisWorkbook.Worksheets("Storage")

    arrws = Array("Jan 19", "Feb 19") 'add all the worksheets you need to loop through

    For Each Source In ThisWorkbook.Worksheets

        HandleIt = Application.Match(Source.Name, arrws, 0)
        If Not IsError(HandleIt) Then
            With Source
                .UsedRange.AutoFilter Field:=8, Criteria1:="yes"
                LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
                Col = .Cells(1, .Columns.Count).End(xlToLeft).Column
                Lrow = Target.Cells(Target.Rows.Count, 1).End(xlUp).Row + 1
                .Range("A2", .Cells(LastRow, Col)).SpecialCells(xlCellTypeVisible).Copy Target.Range("A" & Lrow)
            End With
        End If
    Next Source

End Sub

You will get the same output in just one go avoiding the loop.

Upvotes: 3

Related Questions