VBA to filter a column and past but then build onto that worksheet

[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
Quote ReplyReport Edit

[sintek]

So you are wanting to loop all sheets...Filter Column 26 for "Conflicts" and copy those rows to next row in Sheets("Conflicts")
This assumes Conflicts Sheet exists and and data starts in A1 of each sheet...

Please Login or Register  to view this content.

If not...upload a sample file representing actual data setup...

[abrig005]

Thank you for helping me!
From Worksheets 1 through 4 I need to copy only conflicts in column z and paste into the CONFLICTS worksheet.

If possible, I would only like to copy Columns A through R and Z from each worksheet (skip columns S,T,U,V,W,X)

The workbook will have a blank CONFLICTS tab with prepopulated field names.

As displayed in the CONFLICTS worksheet you will see the name (Column A) shows only those Conflicts in Wokrsheets 1,2,3,4

Hopefully this helps
.
Thank you very much!

[Marc L]

According to your attachment an Excel basics VBA demonstration for starters to paste only to the CONFLICTS worksheet module :

Sub Demo1() 
        Const C = "Conflict" 
        [A1].CurrentRegion.Offset(1).Clear 
        R& = 2 
    For S& = 1 To Index - 1 
        With Sheets(S).[A1].CurrentRegion.Columns 
            .Item(26).AutoFilter 1, C, , , False 
             N& = Application.Subtotal(103, .Item(1)) - 1 
             If N Then .Item("A:R").Offset(1).Copy Cells(R, 1): R = R + N 
            .AutoFilter 
        End With 
    Next 
        If R > 2 Then Range("Z2:Z" & R - 1) = C 
End Sub  

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

[sintek]

copy Columns A through R and Z from each worksheet (skip columns S,T,U,V,W,X)

Your result does not show this...What about Column Y?
This will copy A-R & Z to Conflicts sheet...
In above code-Post 2...Replace red snippet with the below...

Please Login or Register  to view this content.

[Marc L]

Hi sintek,

I don't believe your mod may work as expected, did you ever test it ?

[sintek]

Hi MarcL...No did not...will do quickly

[sintek]

Please Login or Register  to view this content.

[Marc L]

sintek, your code copies the source column Z to the destination column S instead of column Z, the reason of my post #6 ...

[sintek]

@ MarcL

I know the code does that...I am assuming that OP wants only A-R & Z copied...

If possible, I would only like to copy Columns A through R and Z from each worksheet

Am also assuming that OP sample file is not as per his requirement...Other wise it is pointless only copying specific columns as the pasted to file houses 0's in these non copied Columns...So once again, as per so many other posts of ours prior, which are still unanswered...I will wait to see what true requirement is and then easily adapt..

[Marc L]

As I better understand now your point of view 'cause sometimes I do the same,
so weird when the attachment does not exactly match the explanation ...

[sintek]

So just in case OP requirement is as you understand...Slight code mod...

Please Login or Register  to view this content.

[abrig005]

Sintek, this works!

What would change in the code if i changed the names of the worksheets (because the workbook now has other worksheets with different data and i just need the conflicts from these 4)
Worksheet 1 - Unit Activation
Worksheet 2- Unit Deactivation
Worksheet 3 - Unit Realignment
Worksheet 4 - Unit Reorganization

Thanks again for the help everyone

[sintek]

Sintek, this works!

Which code are you referring too as MarcL and I were unsure as to your exact requirement...
Perhaps it would be best if you upload a sample file showing before and after result...Incorporating these new sheets you named above...

[abrig005]

Sub J3v16()
Dim ws As Worksheet
For Each ws In Sheets
If ws.Name <> "CONFLICTS" Then
With ws.Cells(1).CurrentRegion
.AutoFilter 26, "Conflict"
If .Columns(26).SpecialCells(12).Cells.Count - 1 > 0 Then
.Columns("A:R").Offset(1).Copy Sheets("Conflicts").Range("A" & Rows.Count).End(3)(2)
End If
.AutoFilter
End With
End If
Next ws
Sheets("Conflicts").Cells(1).CurrentRegion.Columns(26).SpecialCells(4) = "Conflict"

The image shows the various worksheets currently in my workbook as an example.

Attachment 803078
End Sub

[sintek]

Your attachment is invalid...If I understand then this works...

Please Login or Register  to view this content.

[abrig005]

thank you!

[sintek]

Glad to have contributed...Tx for rep +...Please mark thread as solved...