Autofilter & Copy Macro

**Harlequin** · 07-19-2007, 10:06 AM

Hello

I have a main workbook with 40,000 lines of data for various locations. Column A shows the locations. They all have the same fields in column B to N

I am looking for a macro that will filter on column A (Location name) & for every location in that’s in there,
Copy it, open a new worksheet, paste the data for that location into it, plus, name the tab the same as the location name that’s been pasted in there.

I attach a workbook, of desired results.

Any help would be much appreciated

**ilovedurango** · 07-19-2007, 04:53 PM

Do you want this to be an automatic macro, or just a macro?

**Harlequin** · 07-20-2007, 04:30 AM

Hello.

I need it to be a macro.

Cheers

**ilovedurango** · 07-20-2007, 08:28 AM

Hello,

I've started working on your problem. I have the macro that copies and pastes, I just want to clarify - you are not always shipping to the five cities you have listed, correct? There will be more cities, and when more cities come, you need those worksheets to be automatically created, correct?

**Harlequin** · 07-20-2007, 09:10 AM

Yes, that is correct.

Some new locations may come on board, & some currant ones may not have data in some periods.

Cheers

**ilovedurango** · 07-20-2007, 02:14 PM

I have completed the macro!

Sub DataTransfer()
Dim LastDest As Long
Dim ScrWsht, DestWsht As Worksheet
On Error GoTo trap


'Source Worksheet to copy from
Set ScrWsht = Sheets("TOTAL")

'Destination Worksheet to copy to
Set DestWsht = Sheets(ActiveCell.Value)

'Copy row in TOTAL
ActiveCell.Range("A1:N1").Select
Selection.Copy

'Check to see if Destination Worksheet is Selected
If Not ActiveSheet.Name = DestWsht.Name Then
DestWsht.Select
End If

'Copy and Transpose to next blank row in Column A
Run "Find_Blank"
ActiveCell.Range("A1:N1").Select
ActiveSheet.Paste

Application.CutCopyMode = False


trap:
If Err = 9 Then
    Application.ScreenUpdating = False
    Sheets.Add.Name = ActiveCell.Value
    Range("A1").Select
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "=Header"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:N1"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:N1").Select
    Selection.Font.Bold = True
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 15.29
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 10.14
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 8.29
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 9.86
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 11.46
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 8.43
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 13.29
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 10.17
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 9
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 10.14
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 10.14
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 10.14
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 23.29
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.ColumnWidth = 4
    ActiveWindow.Zoom = 75
    Application.ScreenUpdating = True
    
End If
   
 
 
 
End Sub

That macro calls this macro to make it run

Sub Find_Blank()
Dim BCell, NBCell
'finds the next empty cell in range 
Range("A1").Select

For I = 1 To 65536
If ActiveCell.Value = Empty Then
BCell = "A" & CStr(I - 1)
NBCell = "A" & CStr(I - 2)
Exit Sub
Else
Range("A" & CStr(I + 1)).Select
End If
Next I
End Sub

I'm still new at this, but this definitely works. The way I have it set up is for you to select the city and then run the macro. I didn't really focus on filtering it, but I can do that as well. Let me know if you have problems.

Katie

Autofilter & Copy Macro

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Autofilter & Copy Macro

Ta da!

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions