VBA to filter a worksheet for a name then copy to a new worksheet then merge?

[abrig005]

Hello,
I have 4 worksheets that all have the same format but different data. Column Z displays only conflict or no conflicts

Im trying to edit this code below to go to each worksheet ( worksheet 1, 2, 3, 4) and copy only the conflicts in Column Z and then paste (merge) them into worksheet CONFLICTS.
So look in column Z in worksheet 1, filter for just conflicts and copy then to a worksheet CONFLICTS
Do the same in worksheet 2 but add them to what was just copied from worksheet 1 AND ADD TO worksheet CONFLICTS
Do the same in worksheet 3 but add them to what was just copied from worksheet 1 and 2, AND ADD TO worksheet CONFLICTS
Do the same in worksheet 4 but add them to what was just copied from worksheet 1 ,2,3 AND ADD TO worksheet CONFLICTS

in the end i need the conflicts worksheet to have all the conflicts from worksheets 1,2,3,4 together---

I HOPE THAT MAKES SENSE


Sub CopyONLYConflicts()

End Sub
Function GetWorksheet(shtName As String) As Worksheet
On Error Resume Next
Set GetWorksheet = Worksheets(shtName)
End Function




Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String

'specify sheet name in which the data is stored
sht = "Unit Activation Template"

'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "F").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:R" & last)

Sheets(sht).Range("F1:F" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True

For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))

If Not GetWorksheet(x.Text) Is Nothing Then
Sheets(x.Text).Delete
End If

With rng
.AutoFilter
.AutoFilter Field:=6, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy

Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
ActiveSheet.Paste
End With
Next x

' Turn off filter
Sheets(sht).AutoFilterMode = False

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

End Function

 

[John_w]

I have 4 worksheets that all have the same format but different data. Column Z displays only conflict or no conflicts

Im trying to edit this code below to go to each worksheet ( worksheet 1, 2, 3, 4) and copy only the conflicts in Column Z and then paste (merge) them into worksheet CONFLICTS.
So look in column Z in worksheet 1, filter for just conflicts and copy then to a worksheet CONFLICTS

Try this macro:

Public Sub Filter_and_Append_Conflicts()

    Dim conflictsDest As Range
    Dim i As Long
    
    With Worksheets("CONFLICTS")
        .Cells.Clear
        Set conflictsDest = .Range("A1")
    End With
    
    Application.ScreenUpdating = False
        
    For i = 1 To 4
    
        With Worksheets(i)
    
            With .UsedRange
                .AutoFilter
                .AutoFilter Field:=26, Criteria1:="conflict"
                If conflictsDest.Row = 1 Then
                    .SpecialCells(xlCellTypeVisible).Copy conflictsDest
                Else
                    .SpecialCells(xlCellTypeVisible).Offset(1).Copy conflictsDest
                End If
            End With
            
            With conflictsDest.Worksheet
                Set conflictsDest = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            End With
            
            .AutoFilterMode = False
            
        End With
        
    Next
        
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With

End Sub

 

[abrig005]

Public Sub Filter_and_Append_Conflicts() Dim conflictsDest As Range Dim i As Long With Worksheets("CONFLICTS") .Cells.Clear Set conflictsDest = .Range("A1") End With Application.ScreenUpdating = False For i = 1 To 4 With Worksheets(i) With .UsedRange .AutoFilter .AutoFilter Field:=26, Criteria1:="conflict" If conflictsDest.Row = 1 Then .SpecialCells(xlCellTypeVisible).Copy conflictsDest Else .SpecialCells(xlCellTypeVisible).Offset(1).Copy conflictsDest End If End With With conflictsDest.Worksheet Set conflictsDest = .Cells(.Rows.Count, "A").End(xlUp).Offset(1) End With .AutoFilterMode = False End With Next With Application .CutCopyMode = False .ScreenUpdating = True End With End Sub

John, I can't thank you enough! Have a great weekend!