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

outlawdevil

Board Regular
Joined
Jun 30, 2009
Messages
237
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.

VBA Code:
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
 

Attachments

  • data tab.png
    data tab.png
    18 KB · Views: 15
  • Upload tab.jpg
    Upload tab.jpg
    52.2 KB · Views: 15

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,075
Try this,

VBA Code:
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
 
Solution

outlawdevil

Board Regular
Joined
Jun 30, 2009
Messages
237
Try this,

VBA Code:
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.
 

Attachments

  • UPload tab.png
    UPload tab.png
    8.8 KB · Views: 8

outlawdevil

Board Regular
Joined
Jun 30, 2009
Messages
237
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!
 

Watch MrExcel Video

Forum statistics

Threads
1,119,004
Messages
5,575,518
Members
412,672
Latest member
Tupelo1984
Top