Find cell containing a text in a Column from multiple sheets, then copy that row and paste it in a new sheet

[tommiexboi]

Hello,

I have a workbook with about 20 sheets.
Column A in each sheet contains "Purchase / Forecast - XXXXX", it will say "Purchase / Forecast" but the XXXXX can change.

I would like to create a VBA that will:

1) Go through each sheet and from Column A find the row that contains string "Purchase / Forecast"
2) Copy that Row
3) Paste that Row in a new sheet called "New" as a value (Paste in B1 is preferable)

Any help will be awesome.

Thanks!

 

[My Aswer Is This]

You said:
2) Copy that Row
3) Paste that Row in a new sheet called "New" as a value (Paste in B1 is preferable)

If we copy the row we must paste the entire row so we must start pasting in column A not column B

Try this:

Sub Copy_Row_If()
'Modified  3/4/2021  12:01:56 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim b As Long
Dim c As Long
Dim s As Variant
Dim lastrow As Long
Dim lastrowa As Long
Dim ans As String
c = 1
Sheets.Add(Before:=Sheets(1)).Name = "New"

    For i = 2 To Sheets.Count
        ans = Sheets(i).Name
        lastrow = Sheets(i).Cells(Rows.Count, c).End(xlUp).Row
        lastrowa = Sheets("New").Cells(Rows.Count, 1).End(xlUp).Row + 1
   
        With Sheets(i).Cells(1, c).Resize(lastrow)
            .AutoFilter Field:=1, Criteria1:="=*Purchase / Forecast*", Operator:=xlFilterValues
            counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
            If counter > 1 Then
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("New").Cells(lastrowa, 1)
            Else
                MsgBox "No values found on " & vbNewLine & "Sheets " & Sheets(i).Name
            End If
            .AutoFilter
        End With
    Next

Application.ScreenUpdating = True
End Sub

 

[tommiexboi]

Awesome! I really like the MSG box that's a great added touch.

Would it be possible to paste the row as values?
The rows have formula's in some of the cells and I would like to just bring over the values.

 

[My Aswer Is This]

Try this:

Sub Copy_Row_If()
'Modified  3/4/2021  11:39:26 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim b As Long
Dim c As Long
Dim s As Variant
Dim lastrow As Long
Dim lastrowa As Long
Dim ans As String
c = 1
Sheets.Add(Before:=Sheets(1)).Name = "New"

    For i = 2 To Sheets.Count
        ans = Sheets(i).Name
        lastrow = Sheets(i).Cells(Rows.Count, c).End(xlUp).Row
        lastrowa = Sheets("New").Cells(Rows.Count, 1).End(xlUp).Row + 1
   
        With Sheets(i).Cells(1, c).Resize(lastrow)
            .AutoFilter Field:=1, Criteria1:="=*Purchase / Forecast*", Operator:=xlFilterValues
            counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
            If counter > 1 Then
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy: Sheets("New").Cells(lastrowa, 1).PasteSpecial xlPasteValues
            Else
                MsgBox "No values found on " & vbNewLine & "Sheets " & Sheets(i).Name
            End If
            .AutoFilter
        End With
    Next

Application.ScreenUpdating = True
End Sub

 

[balrajsingh78]

This looks promising. I have an issue with a slight difference. I have a worksheet with a long list of customer names and an identifier along with some other information. I can easily sort them alphabetically, however, I need to separate all customer records (rows) for customers with names starting with 'A' in one worksheet, all those starting with 'B' in the second worksheet, and so on. So in brief, starting at row 2, the code needs to:

1) Copy all rows with customer name starting with A to the worksheet named 'A' (copy into rows 2 onwards)
2) repeat the same for every letter of the alphabet, copying the rows into separate sheets.

Can anyone please help?

 

[My Aswer Is This]

This looks promising. I have an issue with a slight difference. I have a worksheet with a long list of customer names and an identifier along with some other information. I can easily sort them alphabetically, however, I need to separate all customer records (rows) for customers with names starting with 'A' in one worksheet, all those starting with 'B' in the second worksheet, and so on. So in brief, starting at row 2, the code needs to:

1) Copy all rows with customer name starting with A to the worksheet named 'A' (copy into rows 2 onwards)
2) repeat the same for every letter of the alphabet, copying the rows into separate sheets.

Can anyone please help?

You need to start a new posting for this question.

 

[balrajsingh78]

Thanks. Will do that.