I am not familiar with VBA so please forgive the simplicity of this question. I have a recorded macro which selects, opens then saves a file from a hyperlink in one of my columns. I just want to make a loop to repeat this macro down all of the rows in the worksheet which have data in them. Below is the code for the recorded macro, thank you all for your assistance.
Sub Extract()
'
'Extract Macro
'
'
Range("D2").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Workbooks.Open Filename:= _
"https://channele.corp.etradegrp.com/communities/teams02/performance-monitoring/TPEF%20Library/A2Consulting_Tech_5650_VSAF.xlsm"
ActiveWindow.Visible = False
Windows("A2Consulting_Tech_5650_VSAF.xlsm").Visible = True
ChDir "O:\Procurement Planning\QA"
ActiveWorkbook.SaveAs Filename:= _
"O:\Procurement Planning\QA\Copy of A2Consulting_Tech_5650_VSAF.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
End Sub
Something like this might work already:
Sub Extract()
Dim RngTarget As Range
Dim StrFileName As String
Set RngTarget = Range("D2")
Do Until RngTarget.Value = ""
RngTarget.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Workbooks.Open Filename:=RngTarget.Value
StrFileName = Split(RngTarget.Value, "/")(UBound(Split(RngTarget.Value, "/")))
Windows(StrFileName).Visible = True
Workbooks(StrFileName).SaveAs Filename:="O:\Procurement Planning\QA\Copy of " & Split(StrFileName, ".")(0) & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
Workbooks(StrFileName).Close
Set RngTarget = RngTarget.Offset(1, 0)
Loop
End Sub
I am very new to the world of Excel VBA World, I am currently working on merging multiple worksheets from different .csv files (same folder) into one giant .csv file.
Previously, I have already ran a code (successfully) to select all the data I wanted to all the .csv files in that folder. But I can't seem to merge all the sheets from these files into one....
This is the successful code
Option Explicit
Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
'your code here
OP10SelectCut
End With
xFileName = Dir
Loop
End If
End Sub
Sub OP10SelectCut()
'
' OP10SelectCut 巨集
'
'
Dim TotalRow As Integer
TotalRow = Range("B1").End(xlDown).Row
Columns("B:B").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
Formula1:="=-0.02", Formula2:="=0.02"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.AutoFilter
ActiveSheet.Range("$B$1:$B$" & TotalRow).AutoFilter Field:=1, Criteria1:=RGB(255 _
, 255, 0), Operator:=xlFilterCellColor
Columns("B:C").Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
End Sub
This is the not working code
'合併多個Excel檔案
Sub GetSheets()
Path = "C:\Users\andrew-wu\Desktop\OP10TestBatch"
Filename = Dir(Path & "*.csv*")
Do While Filename <> "*.csv*"
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
'只複製第一個Sheet
If ActiveWorkbook.Sheets.Count > 0 Then
ActiveWorkbook.Sheets(1).Copy _
After:=ThisWorkbook.Sheets(1)
'每個Sheet都複製
'For Each Sheet In ActiveWorkbook.Sheets
'Sheet.Copy After:=ThisWorkbook.Sheets(1)
'Next Sheet
End If
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
I have a workbook already with a macro that does several things based on a cell value:
When i change a cell value (its a store name) the code will filter several sheets with, just to show the store of that specific cell, then hides several sheets.
Just showing 2 specific sheets.
And in the end of the code i save a new workbook with the name of that store.
My question is:
Is it possible to change my code (shown below), so i dont have to write manually the name of the store, ie, i want that the macro sees a list of stores, then change the cell with each store, do all the tasks i want, and then writes a new workbook with that store name, and so on, until the end of the list store?
Thank you so much
(PS: im new in vba, so my code probably is a little rough around the edges)
Sub Nova_loja()
Dim sht As Worksheet
Dim Fname As String
Dim Cell As Range, cRange As Range
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
'copy past in values
With Range("K44:L66")
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
'filter and delete
Sheets("BD Geral").Select
ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=52, Criteria1:="<>" & Worksheets("Tabela - Média Mensal").Range("B2").value, Operator:=xlFilterValues
Application.DisplayAlerts = False
ActiveSheet.ListObjects("Table2").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
ActiveSheet.ListObjects("Table2").AutoFilter.ShowAllData
'filter and delete
Sheets("BD BONUS_MALUS").Select
ActiveSheet.ListObjects("Table35").Range.AutoFilter Field:=3, Criteria1:="<>" & Worksheets("Tabela - Média Mensal").Range("B1").value, Operator:=xlFilterValues
Application.DisplayAlerts = False
ActiveSheet.ListObjects("Table35").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
ActiveSheet.ListObjects("Table35").AutoFilter.ShowAllData
'filter and delete
Sheets("BD NPS").Select
ActiveSheet.ListObjects("Table3").Range.AutoFilter Field:=2, Criteria1:="<>" & Worksheets("Tabela - Média Mensal").Range("B1").value, Operator:=xlFilterValues
Application.DisplayAlerts = False
ActiveSheet.ListObjects("Table3").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
ActiveSheet.ListObjects("Table3").AutoFilter.ShowAllData
Sheets("BD Dept").Select
ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=8, Criteria1:="<>" & Worksheets("Tabela - Média Mensal").Range("B1").value, Operator:=xlFilterValues
Application.DisplayAlerts = False
ActiveSheet.ListObjects("Table4").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
ActiveSheet.ListObjects("Table4").AutoFilter.ShowAllData
'refresh pivots
ThisWorkbook.RefreshAll
'hide sheets
For Each sht In ThisWorkbook.Worksheets
If sht.Name <> "Dashboard" And sht.Name <> "Tabela - Média Mensal" Then
sht.Visible = xlSheetVeryHidden
End If
Next sht
'protect sheets
For Each sht In ActiveWorkbook.Sheets
sht.Protect Password:="fnacrh", AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Next
'leave active main worksheet
Sheets("Dashboard").Select
'save as with new name
Application.DisplayAlerts = False
Fname = ThisWorkbook.Path & "\" & "02.VIM_REPORT MENSAL - " & Worksheets("aux").Range("V2") & " - " & Worksheets("aux").Range("V3") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=xlWorkbookDefault
Application.DisplayAlerts = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
End Sub
Thank you so much
The next code would do what I understood you need.
Copy the next code in a module of another workbook, different from the one to be processed, and run AutomaticallySelectStore procedure. An InputBox will appear asking to select the number from the right side of the workbook name to be processed.
Sub AutomaticallySelectStore()
Dim w As Workbook, Wb As Workbook, sh As Worksheet, store As Variant, Arr As Variant, Ans As String
Dim i As Long, strWorkb As String, strWbName As String, strWbPath As String, nrStores As Long
strWorkb = "Please write the number of the workbook needed to be processed:" & vbCrLf & vbCrLf
For Each Wb In Workbooks
i = i + 1
strWorkb = strWorkb & Wb.name & " - " & i & vbCrLf
Next
strWorkb = left(strWorkb, Len(strWorkb) - 1)
Ans = InputBox(strWorkb, "Necessary workbook selection", 1)
If Ans = "" Then MsgBox "You did not select anything...", vbInformation, "No workbook selected": Exit Sub
If Not IsNumeric(Ans) Then
MsgBox "You must write the number from the right side of the needed workbook name!", vbInformation, _
"Wrong choice...": Exit Sub
ElseIf Ans > Workbooks.Count Then
MsgBox "You must write a number less or equal with " & Workbooks.Count, vbInformation, _
"Wrong chosen number": Exit Sub
End If
Set w = Workbooks(CLng(Ans))
On Error Resume Next
Set sh = w.Worksheets("aux")
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
MsgBox "The chosen workbook looks to be wrong..." & vbCrLf & _
" Worksheet ""Tabela - Média Mensal"" is missing.", vbInformation, _
"Wrong workbook or necessary worksheet missing": Exit Sub
End If
On Error GoTo 0
strWbName = w.FullName
nrStores = sh.Range("AF2").End(xlDown).Row
Arr = sh.Range("AF2:AF" & nrStores)
w.Activate
i = 0
Application.Calculation = xlCalculationManual
For Each store In Arr
i = i + 1
Nova_loja strWbName, store, i, nrStores - 1
Next
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = "Ready..."
End Sub
Sub Nova_loja(strWbName As String, store As Variant, No As Long, NrPag As Long)
Dim sht As Worksheet, fName As String, Cell As Range, cRange As Range
Dim w As Workbook, Wb As Workbook, boolFound As Boolean, shortName As String
Dim Arr As Variant, shAr As Worksheet, shortWbName As String
shortWbName = Right(strWbName, Len(strWbName) - InStrRev(strWbName, "\"))
For Each Wb In Workbooks
If Wb.FullName = strWbName Then
Set w = Wb: boolFound = True: Exit For
End If
Next
If Not boolFound Then
Set w = Workbooks.Open(strWbName)
End If
Application.ScreenUpdating = False
Application.StatusBar = "Working on " & store & " store (" & No & " of " & NrPag & ")..."
Application.CalculateBeforeSave = True
Set shAr = Workbooks(shortWbName).Worksheets("aux")
Arr = shAr.Range("K44:L66")
shAr.Range("K44:L66") = Arr
Sheets("Tabela - Média Mensal").Range("B2").Value = store
Sheets("BD Geral").ListObjects("Table2").Range.AutoFilter field:=52, Criteria1:="<>" & store, _
Operator:=xlFilterValues
Application.DisplayAlerts = False
Sheets("BD Geral").ListObjects("Table2").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Sheets("BD Geral").ListObjects("Table2").AutoFilter.ShowAllData 'it returns an error if no filter is applied
Application.DisplayAlerts = True
'filter and delete
Sheets("BD BONUS_MALUS").ListObjects("Table35").Range.AutoFilter field:=3, Criteria1:="<>" & Worksheets("Tabela - Média Mensal").Range("B1").Value, Operator:=xlFilterValues
Application.DisplayAlerts = False
Sheets("BD BONUS_MALUS").ListObjects("Table35").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
Sheets("BD BONUS_MALUS").ListObjects("Table35").AutoFilter.ShowAllData
'filter and delete
Sheets("BD NPS").ListObjects("Table3").Range.AutoFilter field:=2, Criteria1:="<>" & Worksheets("Tabela - Média Mensal").Range("B1").Value, Operator:=xlFilterValues
Application.DisplayAlerts = False
Sheets("BD NPS").ListObjects("Table3").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
Sheets("BD NPS").ListObjects("Table3").AutoFilter.ShowAllData
'This sheet does not contain any "Table"...
Sheets("BD Dept").ListObjects("Table4").Range.AutoFilter field:=8, Criteria1:="<>" & Worksheets("Tabela - Média Mensal").Range("B1").Value, Operator:=xlFilterValues
Application.DisplayAlerts = False
Sheets("BD Dept").ListObjects("Table4").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
Sheets("BD Dept").ListObjects("Table4").AutoFilter.ShowAllData
'hide sheets
For Each sht In w.Worksheets
If sht.name <> "Dashboard" And sht.name <> "Tabela - Média Mensal" Then
sht.Visible = xlSheetVeryHidden
End If
Next sht
'protect sheets
For Each sht In ActiveWorkbook.Sheets
sht.Protect Password:="fnacrh", AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Next
'leave active main worksheet
Sheets("Dashboard").Select
w.RefreshAll
shortName = "02.VIM_REPORT MENSAL - " & store & " - " & Worksheets("aux").Range("V3") & ".xlsx"
fName = w.Path & "\" & shortName
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=fName, FileFormat:=xlWorkbookDefault
Workbooks(shortName).Close , False
Application.DisplayAlerts = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
End Sub
Please, test it and confirm if it works as expected.
If not, mention what wrong happens.
Would that 'list of stores' be another excel workbook/sheet?
Do we have to deduce where the 'store' in discussion exists in your workbook?
Isn't it better you to describe where the change must be done?
Of course, this is not an answer but I do not know how else I can clarify the issue...
Sub AutomaticallySelectStore()
Dim W As Workbook, Sh As Worksheet, store As Variant, Arr As Variant
Set W = ActiveWorkbook
Set Sh = W.Worksheets("Tabela - Média Mensal")
Arr = Sh.Range("AF2:AF" & Sh.Range("AF2").SpecialCells(xlCellTypeLastCell).Row)
For Each store In Arr
Nova_loja store
Next
End Sub
Sub Nova_loja(store As Variant)
Dim sht As Worksheet, Fname As String, Cell As Range, cRange As Range
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
With Range("K44:L66")
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
'filter and delete
Sheets("BD Geral").Select
ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=52, Criteria1:="<>" & store, Operator:=xlFilterValues
Application.DisplayAlerts = False
ActiveSheet.ListObjects("Table2").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
ActiveSheet.ListObjects("Table2").AutoFilter.ShowAllData
'filter and delete
Sheets("BD BONUS_MALUS").Select
ActiveSheet.ListObjects("Table35").Range.AutoFilter Field:=3, Criteria1:="<>" & Worksheets("Tabela - Média Mensal").Range("B1").Value, Operator:=xlFilterValues
Application.DisplayAlerts = False
ActiveSheet.ListObjects("Table35").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
ActiveSheet.ListObjects("Table35").AutoFilter.ShowAllData
'filter and delete
Sheets("BD NPS").Select
ActiveSheet.ListObjects("Table3").Range.AutoFilter Field:=2, Criteria1:="<>" & Worksheets("Tabela - Média Mensal").Range("B1").Value, Operator:=xlFilterValues
Application.DisplayAlerts = False
ActiveSheet.ListObjects("Table3").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
ActiveSheet.ListObjects("Table3").AutoFilter.ShowAllData
Sheets("BD Dept").Select
ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=8, Criteria1:="<>" & Worksheets("Tabela - Média Mensal").Range("B1").Value, Operator:=xlFilterValues
Application.DisplayAlerts = False
ActiveSheet.ListObjects("Table4").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
ActiveSheet.ListObjects("Table4").AutoFilter.ShowAllData
'refresh pivots
ThisWorkbook.RefreshAll
'hide sheets
For Each sht In ThisWorkbook.Worksheets
If sht.Name <> "Dashboard" And sht.Name <> "Tabela - Média Mensal" Then
sht.Visible = xlSheetVeryHidden
End If
Next sht
'protect sheets
For Each sht In ActiveWorkbook.Sheets
sht.Protect Password:="fnacrh", AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Next
'leave active main worksheet
Sheets("Dashboard").Select
'save as with new name
Application.DisplayAlerts = False
Fname = ThisWorkbook.Path & "\" & "02.VIM_REPORT MENSAL - " & Worksheets("aux").Range("V2") & " - " & Worksheets("aux").Range("V3") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=xlWorkbookDefault
Application.DisplayAlerts = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
End Sub
So, you must run 'AutomaticallySelectStore' procedure and wait...
I do not have such a file in order to test it, so, it is a code based only on VBA logic and my understanding about your situation.
Depending on how big are your workbooks it may load your system RAM and CPU, working continuously. I am waiting for some feedback.
The initial code can also be optimized a little, but let us see how it works now.
My script can detect rows and column in first round but in the second round cannot detect rows and column.
It shows
"run-time error '1004' : "\" could not be found.
Is there some missing code or is the sequence I put wrong?
Sub Conso()
' Get common values, eg. path, date
Call getValues
Workbooks("Daily Reporting Template.xlsm").Activate
Worksheets("Master").Activate
'Open Staff Input Value
Dim i As Integer
'Dim j As Long
'j = Cells(Rows.Count, 13).End(xlUp).Row
For i = 7 To 30
StaffPath = Cells(i, 4).Value
Ws = Cells(i, 3).Value
THPath = Cells(3, 2).Value
wrkFold = Cells(2, 2).Value
Filename = Cells(4, 2).Value
'Open Template
'Workbooks.Open Filename:= _
' wrkFold & "Master TH\Template\Daily Reporting Template.xlsm", UpdateLinks:=3
Windows("Daily Reporting Template.xlsm").Activate
Workbooks.Open Filename:= _
StaffPath & "\" & Filename & ".xlsm", UpdateLinks:=3
Cells.Select
Selection.Copy
Windows("Daily Reporting Template.xlsm").Activate
Sheets(Ws).Activate
Cells.Select
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:= _
THPath & "Daily Reporting Template" & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = False
Windows(Filename & ".xlsm").Close
Next i
End Sub
Your code picks the value based on active sheet. This causes issues during Loop since it just refers to different file. Try the following code.
UnTested
Sub Conso()
Dim DailyRptTemplate As Workbook, MasterSht As Worksheet, TempWbk As Workbook
' Get common values, eg. path, date
Call getValues
Set DailyRptTemplate = Workbooks("Daily Reporting Template.xlsm")
Set MasterSht = DailyRptTemplate.Worksheets("Master")
Application.DisplayAlerts = False
'Open Staff Input Value
Dim i As Integer
'Dim j As Long
'j = Cells(Rows.Count, 13).End(xlUp).Row
For i = 7 To 30
StaffPath = MasterSht.MasterShtCells(i, 4).Value
WS = MasterSht.Cells(i, 3).Value
THPath = MasterSht.Cells(3, 2).Value
wrkFold = MasterSht.Cells(2, 2).Value
Filename = MasterSht.Cells(4, 2).Value
'Open Template
'Workbooks.Open Filename:= _
'wrkFold & "Master TH\Template\Daily Reporting Template.xlsm", UpdateLinks:=3
Set TempWbk = Workbooks.Open(Filename:=StaffPath & "\" & Filename & ".xlsm", UpdateLinks:=3)
TempWbk.Cells.Copy
DailyRptTemplate.Worksheets(WS).Range("A1").Paste
DailyRptTemplate.SaveAs Filename:=THPath & "Daily Reporting Template" & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
TempWbk.Close (False)
Next i
Application.DisplayAlerts = True
End Sub
It is also worth to have look at the below section since these are not looped through the procedure.
THPath = MasterSht.Cells(3, 2).Value
wrkFold = MasterSht.Cells(2, 2).Value
Filename = MasterSht.Cells(4, 2).Value
I have one large Excel workbook with multiple worksheets containing pivot tables linked to a big PowerPivot source. I want to save each worksheet separately into workbooks, only as values.
I have managed to do this on a workbook without pivot tables. But I get the following message with this project. I don't want to copy the embedded data for each save as it is crazy slow. Any hints or help?
Option Explicit
Sub JhSeparateSave()
Dim ws As Worksheet
Dim NewName As String
If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
"New sheets will be pasted as values, named ranges removed" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub
' Input box to name new file
NewName = InputBox("Please Specify the name of your new workbook", "New Copy")
With Application
.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
MsgBox ("Copy step 1")
ws.Copy
With ActiveWorkbook.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewName & "-" & ws.Name
ActiveWorkbook.Close
MsgBox ("Saved sheet: " & ws.Name)
End If
Next ws
End With
End Sub
See this example (TESTED AND TRIED).
Option Explicit
Sub JhSeparateSave()
Dim wbTemp As Workbook
Dim ws As Worksheet
Dim NewName As String
If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
"New sheets will be pasted as values, named ranges removed" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub
'~~> Input box to name new file
NewName = InputBox("Please Specify the name of your new workbook", "New Copy")
With Application
.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
MsgBox ("Copy step 1")
ws.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & NewName & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close savechanges:=False
Set wbTemp = Workbooks.Open(ThisWorkbook.Path & "\" & NewName & ".csv")
wbTemp.SaveAs Filename:=ThisWorkbook.Path & "\" & NewName & "-" & ws.Name, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
wbTemp.Close savechanges:=False
Kill ThisWorkbook.Path & "\" & NewName & ".csv"
MsgBox ("Saved sheet: " & ws.Name)
End If
Next ws
End With
End Sub
what i eventually used:
Option Explicit
Sub Copier()
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim NewName As String
Dim wsOriginalName As String
'On Error GoTo Errorcatch
If MsgBox("1. Copy to new sheet. 2. Change to values. 3. Move to new workbook" & vbCr & _
"New sheets will be pasted as values, named ranges removed" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub
' Input box to name new file
NewName = InputBox("Please Specify the month name of your new workbook", "New Copy")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
'iterate through all worksheets
For Each ws In ThisWorkbook.Worksheets
'ignore hidden worksheets
If ws.Visible = xlSheetVisible Then
'copy sheet within original workbook
wsOriginalName = ws.Name
ws.Copy After:=Sheets("FAQ")
'switch to copied sheet
Set wsNew = ActiveSheet
'convert to values and format
With wsNew.UsedRange
.Copy
.PasteSpecial xlPasteValuesAndNumberFormats
.PasteSpecial xlPasteFormats
.Cells(1, 1).Select
End With
'save into new workbook
wsNew.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "MIS-FY2013-" & NewName & "-" & wsOriginalName
ActiveWorkbook.Close
'MsgBox ("going to try to delete: " & wsNew.Name)
'delete copied sheet
wsNew.Delete
End If
Next ws
End With
End Sub