Hi, I hope someone can help me. I'm trying to find out why the below macro doesnt work and tried to search online with no luck. My skills are clearly very basic so would appreciate if you can point me to the right direction.
I have template with 3 sheets, 2 are pivot tables and 1 is "Customer raw data". I have a column number 59 which is a unique key to a file name that has to be created and the raw data has to be copied there. I want also the two pivot table sheets to be copied but I'm not able as the highlighted line in red is giving me errors. I will after also add the refresh pivot table and to connect to the right source of data but that would be next step.
Sub CSVSpliter()
Dim wb As Workbook, c As Range
With ActiveSheet
Intersect(.Columns(59), .UsedRange).AdvancedFilter xlFilterCopy, , .Cells(Rows.Count, 2).End(xlUp)(3), True
For Each c In .Cells(Rows.Count, 2).End(xlUp).CurrentRegion.Offset(1)
If c <> "" Then
Set wb = Workbooks.Add
.UsedRange.AutoFilter 59, c.Value
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
wb.Sheets(1).Range("a1").PasteSpecial xlPasteAll
wb.Sheets(1).Range("BG:BG").EntireColumn.Delete
ActiveSheet.Name = "Customer raw data"
wb.Sheets(Array("Top_Line_Reconcile", "Units_by_Month")).Copy
wb.SaveAs ThisWorkbook.Path & "\" & c.Value & ".xlsx" ', 6
.AutoFilterMode = False
wb.Close False
End If
Next
.Cells(Rows.Count, 2).End(xlUp).CurrentRegion.ClearContents
End With
End Sub
I have template with 3 sheets, 2 are pivot tables and 1 is "Customer raw data". I have a column number 59 which is a unique key to a file name that has to be created and the raw data has to be copied there. I want also the two pivot table sheets to be copied but I'm not able as the highlighted line in red is giving me errors. I will after also add the refresh pivot table and to connect to the right source of data but that would be next step.
Sub CSVSpliter()
Dim wb As Workbook, c As Range
With ActiveSheet
Intersect(.Columns(59), .UsedRange).AdvancedFilter xlFilterCopy, , .Cells(Rows.Count, 2).End(xlUp)(3), True
For Each c In .Cells(Rows.Count, 2).End(xlUp).CurrentRegion.Offset(1)
If c <> "" Then
Set wb = Workbooks.Add
.UsedRange.AutoFilter 59, c.Value
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
wb.Sheets(1).Range("a1").PasteSpecial xlPasteAll
wb.Sheets(1).Range("BG:BG").EntireColumn.Delete
ActiveSheet.Name = "Customer raw data"
wb.Sheets(Array("Top_Line_Reconcile", "Units_by_Month")).Copy
wb.SaveAs ThisWorkbook.Path & "\" & c.Value & ".xlsx" ', 6
.AutoFilterMode = False
wb.Close False
End If
Next
.Cells(Rows.Count, 2).End(xlUp).CurrentRegion.ClearContents
End With
End Sub