Filtering, and Copying

**freehawk** · 12-16-2009, 05:24 AM

HI. As in the title, I have a question regarding filtering and copying. I have 65536 number of rows filled with cells and sums, and I what I would like is to filter them, and copy each sum into new worksheet. It can be created by the program, or I can create it, whichever is easier. For example: in Folder named " Excel" I have 20 empty worksheets, being from 1 to 20. Then, the program would filter the numbers( all of them) and copy them into the worksheet in Excel folder, named Excel1). By all of them I mean that in the worksheet there will be alot of numbers to be grouped, like 15,16,17 and so on, and in order to filtering number 15 would open, copy the numbers, and paste them into the Excel1 in i folder called " Excel". Is it possible? If so, how to do it?

Thanks

**rwgrietveld** · 12-16-2009, 05:31 AM

It is possible, but Pivot Tables were invented to do just that.

Next option is to use SubTotals.

When that data needs (really has to) to be put in seperate Workbooks (note the difference between WorkBook and WorkSheet) then it requires VBA coding and you'll need to post an example WorkBook with a few lines of data (<65536)

**freehawk** · 12-16-2009, 06:00 AM

Yeah, I would rather to have it in different workbook, not worksheet. Also, I have more such workbooks with 2 worksheets in each with 65536 numbers, and if in other workbook or worksheet the number 20 will be filtered, then I would like to be copied to the folder with numbers 20, and so on. Btw,here is the attachment:

Thanks in advance

**rwgrietveld** · 12-16-2009, 07:10 AM

to be copied to the folder

My procedure would look like
1) Filter on column F. As these have the numbers 16 till 66 they will be grouped in 20 steps (MAX-MIN/20 ???)
2) These filtered ranges need to be SAVED into different Workbooks in a specific folder ??? For simplicity I hope these do not exist already and the data needs to be added.

Save as is much easier than OPEN/PASTE/CLOSE.

Please comment

**freehawk** · 12-16-2009, 11:03 AM

Originally Posted by rwgrietveld

My procedure would look like
1) Filter on column F. As these have the numbers 16 till 66 they will be grouped in 20 steps (MAX-MIN/20 ???)

What I mean is that if there are number from 15 to 66 for example, then I would like to make as much folders as there are numbers, meaning that, I would filter column F, choose to filter number 15, and how many I will get, I want them to be copied, and make a new worksheet which can be called " ExcelSum15" and copy the filtering there. Then, I would go back, choose to filter number 16, look how much will come up, copy them, make a special worksheet for numbers 16 "ExcelSum16" and paste it there. I would like to do it with all the numbers that follow, with the same procedure. Additionally, I would like to make it for every sheet, and if there would be numbers like 15 or 16, then it would not create another worksheet for number 15, but paste it in in the worksheet that has numbers 15 in it.

Thanks

**rwgrietveld** · 12-16-2009, 04:57 PM

I still think this is overkill, but it's yours

Code:

Sub Macro1()
    
Dim FilterRng As Range, Ccell As Range
Dim WsMaster As Worksheet
Dim FilterValues() As Variant
Dim x As Long

Set WsMaster = Worksheets("Master")
Set FilterRng = Range(WsMaster.Range("B2"), WsMaster.Range("F65536").End(xlUp))
x = 1
ReDim FilterValues(1 To FilterRng.Rows.Count)

'Range of possible criteria values
For Each Ccell In Intersect(FilterRng, WsMaster.Range("F:F")) 'Last Column
  If Application.WorksheetFunction.CountIf(Range(WsMaster.Range("F2"), Ccell), "=" & Ccell) = 1 Then
    FilterValues(x) = Ccell
    x = x + 1
  End If
Next

ReDim Preserve FilterValues(1 To x)

For x = LBound(FilterValues) To UBound(FilterValues)
  If FilterValues(x) <> "" Then
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    Worksheets.Item(Worksheets.Count).Name = "ExcelSum" & FilterValues(x)
    
    FilterRng.AutoFilter Field:=6, Criteria1:=FilterValues(x)
    WsMaster.AutoFilter.Range.Copy
    Worksheets.Item(Worksheets.Count).Range("A1").PasteSpecial Paste:=xlPasteValues
  End If
Next x

End Sub