1
votes

I am building out a workbook where every sheet is for a different stage of a software installation. I am trying to aggregate the steps that fail by copying my fail rows into a summary sheet. I finally got them to pull, but they are pulling into the new sheet on the same row # as they are located in the original sheet.

Here is what I am using now:

Option Explicit

Sub Test()

Dim Cell As Range

With Sheets(7)
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("D1:D" & .Cells(.Rows.Count, "D").End(xlUp).Row)
        If Cell.Value = "Fail" Then
             ' Copy>>Paste in 1-line (no need to use Select)
            .Rows(Cell.Row).Copy Destination:=Sheets(2).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next Cell
End With

End Sub

I need to:

  1. Pull row that has cell containing "Fail"
  2. Copy row into master starting at Row 4 and consecutively down without overwriting
  3. Run across all sheets at once- *(they are named per step of install - do i need to rename to "sheet1, sheet2, etc"????)
  4. When macro is run clear previous results (to avoid duplicity)

Another user offered me an autofilter macro but it is failing on a 1004 at this line ".AutoFilter 4, "Fail""

Sub Filterfail()

Dim ws As Worksheet, sh As Worksheet
Set sh = Sheets("Master")

Application.ScreenUpdating = False
        
        'sh.UsedRange.Offset(1).Clear  'If required, this line will clear the Master sheet with each transfer of data.
        
        For Each ws In Worksheets
                If ws.Name <> "Master" Then
                        With ws.[A1].CurrentRegion
                                .AutoFilter 4, "Fail"
                                .Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2)
                                .AutoFilter
                        End With
                End If
        Next ws

Application.ScreenUpdating = True

End Sub

2
Uhh, neither of these produced anything? I know I'm bad at VBA but I modified the sheet numbers for my workbook but nothing happens when I run. - Jdorfma

2 Answers

0
votes

Try this:

The text “Completed” in this xRStr = "Completed" script indicates the specific condition that you want to copy rows based on;

C:C in this Set xRg = xWs.Range("C:C") script indicates the specific column where the condition locates.

Public Sub CopyRows()

Dim xWs As Worksheet
Dim xCWs As Worksheet
Dim xRg As Range
Dim xStrName As String
Dim xRStr As String
Dim xRRg As Range
Dim xC As Integer

On Error Resume Next

Application.DisplayAlerts = False

xStr = "New Sheet"
xRStr = "Completed"
Set xCWs = ActiveWorkbook.Worksheets.Item(xStr)
If Not xCWs Is Nothing Then
    xCWs.Delete
End If
Set xCWs = ActiveWorkbook.Worksheets.Add
xCWs.Name = xStr
xC = 1

For Each xWs In ActiveWorkbook.Worksheets
    If xWs.Name <> xStr Then

        Set xRg = xWs.Range("C:C")
        Set xRg = Intersect(xRg, xWs.UsedRange)

        For Each xRRg In xRg
            If xRRg.Value = xRStr Then
               xRRg.EntireRow.Copy
               xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats
               xC = xC + 1
            End If

        Next xRRg
    End If
Next xWs

Application.DisplayAlerts = True

End Sub
0
votes

Here's another way - You'll have to assign your own Sheets - I used 1 & 2 not 2 & 7

Sub Test()
   Dim xRow As Range, xCel As Range, dPtr As Long
   Dim sSht As Worksheet, dSht As Worksheet
   
   ' Assign Source & Destination Sheets - Change to suit yourself
     Set sSht = Sheets(2)
     Set dSht = Sheets(1)
   ' Done
   
   dPtr = Sheets(1).Rows.Count
   dPtr = Sheets(1).Range("D" & dPtr).End(xlUp).Row
   
   For Each xRow In sSht.UsedRange.Rows
      Set xCel = xRow.Cells(1, 1)                 ' xCel is First Column in Used Range (May not be D)
      Set xCel = xCel.Offset(0, 4 - xCel.Column)  ' Ensures xCel is in Column D
      If xCel.Value = "Fail" Then
         dPtr = dPtr + 1
         sSht.Rows(xCel.Row).Copy Destination:=dSht.Rows(dPtr)
      End If
   Next xRow
End Sub

I think one of the problems in your own code relates to this line

    .Rows(Cell.Row).Copy Destination:=Sheets(2).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

The section Rows.Count, "A" should be referring to the destination sheet(2) but isn't because of the line

With Sheets(7)

further up