Goodness! What a quick reply! Thank you =)
Since the post, found this link:
http://www.rondebruin.nl/copy5.htm#AutoFilter
Have managed to combine codefrom that link. Sure I could delete somestuff. But it does ALMOST what I want. HOWEVER,...see below
Sub Copy_With_AdvancedFilter_To_Workbooks_New()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim foldername As String
Dim MyPath As String
Dim FieldNum As Integer
'Name of the sheet with your data
Set ws1 = Sheets("Sheet1") '<<< Change
'Set filter range : A1 is the top left cell of your filter range and
'the header of the first column, D is the last column in the filter range
Set rng = ws1.Range("A1:D" & Rows.Count)
'Set Field number of the filter column
'This example filters on the first field in the range(change the field if needed)
'In this case the range starts in A so Field:=1 is column A, 2 = column B, ......
FieldNum = 1
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
' Add worksheet to copy/Paste the unique list
Set ws2 = Worksheets.Add
'Fill in the path\folder where you want the new folder with the files
'you can use also this "C:\Users\Ron\test"
MyPath = "H:\Nina"
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'Create folder for the new files
foldername = MyPath & Format(Now, "yyyy-mm-dd") & "\"
MkDir foldername
'Add new workbook with one sheet
Set WSNew = Workbooks.Add(XlWBATemplate.xlWBATWorksheet).Worksheets(1)
WSNew.Name = "Netherlands"
'Firstly, remove the AutoFilter
ws1.AutoFilterMode = False
'Filter the range
rng.AutoFilter Field:=1, Criteria1:="=Netherlands"
'Copy the visible data and use PasteSpecial to paste to the new worksheet
ws1.AutoFilter.Range.Copy
With WSNew.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
'Save the file in the newfolder and close it
WSNew.Parent.SaveAs foldername & " Netherlands = ", ws1.Parent.FileFormat
WSNew.Parent.Close False
'Close AutoFilter
ws1.AutoFilterMode = False
MsgBox "Look in " & foldername & " for the files"
ws1.AutoFilterMode = False
'Delete the ws2 sheet
On Error Resume Next
Application.DisplayAlerts = False
ws2 = Worksheets.Delete
Application.DisplayAlerts = True
On Error GoTo 0
MsgBox "Look in " & foldername & " for the files"
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
HOWEVER are some problems i dont know how to deal with:
1. How do I delete the temporary ws2?
2. How do I open a template called eg RESULT and paste filter result beginning at A3?
3. How do i set so that when the filter is done, it only copies and paste vaues in colums A, G and H into columns A, B C in Result-sheet?
Realise totally new post but.. maybe you can help?
