Copy a range of cell to another sheet based on critieria.

[outlawdevil]

I have a worksheet with data tab and upload tab. I want to create a macro that can copy the range of cell from the data tab based on critieria(Blue, Red, White).

I found this macro that almost does what I want but it is pasting critieria range into new sheets. I want everything to be pasted in to specific range of the upload tab. ( I want to reuse this macro everytime, is it possible that it will do a clear content each time when paste into the range?) Can anyone help me modify this macro? thanks. I have attached screenshot for your review as well.

Sub filter()
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 = "Data Tab"

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

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

For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=3, 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 Sub

 

[davesexcel]

Try this,

Sub UsingColection()
    Dim cUnique As Collection
    Dim rng As Range, fRng As Range
    Dim c As Range
    Dim sh As Worksheet, ws As Worksheet
    Dim vNum As Variant

    Set sh = ThisWorkbook.Sheets("Data Tab")
    Set ws = Sheets("Upload Tab")
    
    With sh
        Set rng = .Range("C2:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
        Set fRng = .Range("A1:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
        Set cUnique = New Collection

        On Error Resume Next
        For Each c In rng.Cells
            cUnique.Add c.Value, CStr(c.Value)
        Next c
        On Error GoTo 0

        For Each vNum In cUnique
            .Range("A1").AutoFilter field:=3, Criteria1:=vNum
            With ws
                .Cells(.Rows.Count, 2).End(xlUp).Offset(1, -1) = vNum
                fRng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 1)
            End With
        Next vNum
        .AutoFilterMode = False
        
    End With
End Sub

 

[outlawdevil]

Try this,

Sub UsingColection()
    Dim cUnique As Collection
    Dim rng As Range, fRng As Range
    Dim c As Range
    Dim sh As Worksheet, ws As Worksheet
    Dim vNum As Variant

    Set sh = ThisWorkbook.Sheets("Data Tab")
    Set ws = Sheets("Upload Tab")
   
    With sh
        Set rng = .Range("C2:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
        Set fRng = .Range("A1:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
        Set cUnique = New Collection

        On Error Resume Next
        For Each c In rng.Cells
            cUnique.Add c.Value, CStr(c.Value)
        Next c
        On Error GoTo 0

        For Each vNum In cUnique
            .Range("A1").AutoFilter field:=3, Criteria1:=vNum
            With ws
                .Cells(.Rows.Count, 2).End(xlUp).Offset(1, -1) = vNum
                fRng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 1)
            End With
        Next vNum
        .AutoFilterMode = False
       
    End With
End Sub

Is there a way to make it where I can designate where each critieria range is copy to so I can change based on my preference? It is copying all range under white at the moment. I was thinking maybe make each section 100 rows so I can reuse it each time. It is important to copy the range in to their designated area.

 

[davesexcel]

Clear the ws cells before running the code

 

[outlawdevil]

Is there a way to make it where I can designate where each critieria range is copy to so I can change based on my preference? It is copying all range under white at the moment. I was thinking maybe make each section 100 rows so I can reuse it each time. It is important to copy the range in to their designated area.

Clear the ws cells before running the code

thank you for your help!