Hi,
Hoping someone can please help me, my VBA knowledge is still noob like - i'm learning though! So I have a file and currently what my macro does is separate the spreadsheet by customer, copy and paste just that customer data into a new book and saves that book as the Customer name for the file name. But the user has requested to add in a new column for week number, so now I need to filter it by Customer and the Week number and save for each.. so for example there's plenty of data and each customer can have multiple lines with different week numbers, so i'd like it to save the files as "customer1 for week 1" / "Customer1 for week 2" / "Customer1 for week 3" and so on for each customer.. ?

Customer name is in "A" and week number is in "N"..

I apologise if i've gone against any rules..

My current code is this:

Sub T1_BackUps()
Application.ScreenUpdating = False
Dim x As Range
Dim ws As Worksheet
Dim rng As Range
Dim rng1 As Range
Dim last As Long
Dim sht As String
Dim newBook As Excel.Workbook
Dim Workbk As Excel.Workbook
'Dim weeknum As String
Dim CustomerName As String, FileNumber As String
Dim LastRow As Long



'name the sheet to be filtered
ActiveSheet.Name = "Sheet2"
sht = "Sheet2"

'set the week number
'weeknum = Evaluate("=('Charge sheet'!M1)")

'Workbook where VBA code resides
Set Workbk = ThisWorkbook

'Create New Workbook
Set newBook = Workbooks.Add(xlWBATWorksheet)
Workbk.Activate


'Which coloumn is being filtered
last = Workbk.Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row

With Workbk.Sheets(sht)
Set rng = .Range("A1:N" & last)
End With

Workbk.Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True
For Each x In Workbk.Sheets(sht).Range([AA2,AB2], Cells(Rows.Count, "AA").End(xlUp))

With rng
.AutoFilter
.AutoFilter Field:=1, Criteria1:=x.Value
'.AutoFilter Field:=14, Criteria1:=x.Value

.SpecialCells(xlCellTypeVisible).Copy
newBook.Activate
newBook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = Replace(Left(x.Value, 30), "/", "")

ActiveSheet.Paste

'find last row
finalRow = Cells(Rows.Count, 1).End(xlUp).Row
'add 1 to last row
finalRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
'place total in the last row
Range("H" & finalRow).Value = "=SUM(H2:H" & finalRow - 1 & ")"

'Set column width
Columns("A:A").Select
Selection.ColumnWidth = 32
Columns("B:B").Select
Selection.ColumnWidth = 20
Columns("C:C").Select
Selection.ColumnWidth = 23
Columns("D:D").Select
Selection.ColumnWidth = 12
Columns("E:E").Select
Selection.ColumnWidth = 12
Columns("F:F").Select
Selection.ColumnWidth = 34
Columns("G:G").Select
Selection.ColumnWidth = 35
Columns("H:H").Select

Range("A2").Select



End With

Next x


Dim FPath As String
'enter file path where workbooks are being saved put "around the file path c:\ etc"
FPath = "C:\Customer Billing Backups"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In newBook.Sheets
If ws.Name <> "Sheet1" Then
ws.Copy


'Set Week Number for file path
WeekNo = Range("I2").Value

'Set Folder Destination
FPath = FPath & "\" & WeekNo




Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & "-" & WeekNo & ".xlsx"
Application.ActiveWorkbook.Close False
FPath = "C:\Customer Billing Backups"
End If
Next


Application.DisplayAlerts = True
Application.ScreenUpdating = True

Workbk.Sheets(sht).AutoFilterMode = False

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

End Sub





Would really appreciate if someone could help me out.

Thank you!