I have this code, although it states there is an error.
What i want to do is complete csv file export from the current active sheet, and save it with the information currently in cell A2.
Sub exportCSV()
' export Macro
Range("A:F").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
strName = AprilPayslips.Range("A2")
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & strName
, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = False
Application.DisplayAlerts = True
End Sub
If you want the value of a cell as a string then ask for it :)
strName = Range("A2").Value
These two lines won't do anything as they stand, so remove them:
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Paths should always include the trailing slash so you don't need to add that in:
Sub exportCSV()
strName = Range("A2").Value
Range("A:F").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & strName, FileFormat:=xlCSV, CreateBackup:=False
End Sub
Should work for you, however unless you can be sure that the contents of A2 will always be a valid filename you may run into problems unless you add in some extra validation.
Related
I'm working on a Macro that makes several CSV files from a certain area while applying a filter. There are two issues.
The workbook will be saved as a file-format retrieved from it's name (cell B15 and the word 'Week')
I cannot find a way to loop this Macro until Cell B15 is empty.
Can anyone help? Thanks in advance.
Example wrong format:
Sub CSVMaker()
'
' CSVMaker Macro
'
'
ActiveSheet.Range("$A$17:$M$240000").AutoFilter Field:=2, Criteria1:="<>"
Range("A18:B18").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add.Name = Range("A10").Value & "." & Range("A7").Value & "." & "Week" & Range("B15").Value
ActiveSheet.Paste
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
Sheets("Input").Select
Columns("B:B").Select
Range("B6").Activate
Selection.Delete Shift:=xlToLeft
End Sub
So finally the answer is the filename needs a correct extension like Filename:=ActiveSheet.Name & ".csv".
And I recommend to avoid .Select and do the following:
Option Explicit
Public Sub CSVMaker()
Dim ws As Worksheet
Set ws = ActiveSheet 'better ThisWorkbook.Worksheets("your-sheet-name")
ws.Range("$A$17:$M$240000").AutoFilter Field:=2, Criteria1:="<>"
ws.Range("A18:B18", ws.Range("A18:B18").End(xlDown).End(xlDown)).Copy
Dim SheetName As String
SheetName = ws.Range("A10").Value & "." & Range("A7").Value & "." & "Week" & Range("B15").Value
ThisWorkbook.Sheets.Add.Name = SheetName
ThisWorkbook.Sheets(SheetName).Paste
Application.CutCopyMode = False
Application.DisplayAlerts = False
ThisWorkbook.Sheets(SheetName).Copy
ActiveWorkbook.SaveAs Filename:=SheetName & ".csv", FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
ThisWorkbook.Sheets("Input").Columns("B:B").Delete Shift:=xlToLeft
End Sub
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
My goal is to open multiple excel files from input folder and convert them to .csv in output folder. I am facing minor issues where
code converts .xlsx to .csv , converts .xls to .csv but in output
folder, it stores .csv and .xls files. I can't figure out why .xls
files are also getting stored. I only wish to store .csv files
I only want to convert data from excel 'Sheet1' but the code is
converting data from an active sheet. How to specify to convert
data only from 'Sheet1'?
Option Explicit
Sub ImportMultipleCsvFile()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Dim InputCsvFile As Variant
Dim InputFolder As String, OutputFolder As String
InputFolder = "C:\Users\excel_format"
OutputFolder = "C:\Users\csv_format"
InputCsvFile = Dir(InputFolder & "\*.xl??")
While InputCsvFile <> ""
Workbooks.OpenText Filename:=InputFolder & "\" & InputCsvFile, DataType:=xlDelimited, Comma:=True
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
InputCsvFile = Dir
Wend
Application.Calculation = xlCalculationAutomatic
End Sub
If you change this:
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
to that:
--- to remove VBA codeblocks from Workbook before saving them as .csv, I have used this stackoverflow answer, then I checked it to make sense by using the info from here ---
Dim StartWb As Workbook
Dim TempWb As Workbook
Set StartWb = ActiveWorkbook
Set TempWb = Application.Workbooks.Add
StartWb.Worksheets("Sheet1").Copy Before:=TempWb.Worksheets(1)
If TempWb.Worksheets.Count > 1 Then
Do While (TempWb.Worksheets.Count > 1)
TempWb.Worksheets(TempWb.Worksheets.Count).Delete
Loop
End If
' ----- This is new to delete the codeblocks from your Sheets -----------
Dim Element As Object
For Each Element In TempWb.VBProject.VBComponents
'For Each Item In Element.Collection ' This For loop wasn't needed at the and but I forgot it in
Element.CodeModule.DeleteLines 1, Element.CodeModule.CountOfLines
'Next ' It has most likely thrown up Undeclared Variable error with Option Eplicit
Next
' -----------------------------------------------------------------------
If InStr(StartWb.Name, ".xlsx") Then
TempWb.SaveAs Filename:=OutputFolder & "\" & Replace(StartWb.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ElseIf InStr(StartWb.Name, ".xls") Then
TempWb.SaveAs Filename:=OutputFolder & "\" & Replace(StartWb.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
End If
TempWb.Close (xlNo)
then you will only get your .csv file saved, as well as it will only contain that first sheet.
I would also put these:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
at the end of your code before or after:
Application.Calculation = xlCalculationAutomatic
Also swap this:
ActiveWorkbook.Close
to that:
StartWb.Close (xlNo)
To remove code from workbooks by code you have to change settings in Excel:
I am trying to copy a dynamic range(dyna) from activesheet and paste it to a new workbook located in "E:\1b\", file name based on cell value(J7).
Below is the formula in the dynamic range:
dyna = "=OFFSET(Sheet1!$D$6,0,0,COUNTA(Sheet1!$D:$J),7)"
I need help to do it.
here is code I have
Set wb = Workbooks.Add
ThisWorkbook.Activate
ActiveSheet.dyna.Copy Before:=wb.Sheets(1)
wb.Activate
Application.DisplayAlerts = False
wb.SaveAs "E:\1b\" & Range("J7").Value & ".xlsx",
FileFormat:=xlOpenXMLWorkbook, ReadOnlyRecommended:=False, CreateBackup:=False
wb.Close "E:\1b\" & Range("J7").Value & ".xlsx"
Application.DisplayAlerts = True
End Sub
I have an Excel macro (own recorded), which does following:
in the column A (A1-A90) are placed different formulas. Formula calculation is set to manual.
The macro
copies formula from A1
creates new file
pastes formula into A1 of newly created file
calculates the formel
saves the file
The macro code is:
Sub Makro1()
'
' Makro1 Makro
'
Windows("macrotest.xlsx").Activate
Range("A1").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
ActiveWorkbook.SaveAs Filename:= _
"Z:\Mappe1.csv", FileFormat:=xlCSV, _
CreateBackup:=False
Windows("macrotest.xlsx").Activate
Range("A2").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
ActiveWorkbook.SaveAs Filename:= _
"Z:\Mappe2.csv", FileFormat:=xlCSV, _
CreateBackup:=False
Windows("macrotest.xlsx").Activate
Range("A3").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
ActiveWorkbook.SaveAs Filename:= _
"Z:\Mappe3.csv", FileFormat:=xlCSV, _
CreateBackup:=False
End Sub
I have more then 100 formulas, so it would be nice to have two loops in the macro instead of paste 100 code snippets into macro code:
one loop would take formulas from the range A1-A90 one by one to paste into created files
second loop would give forthcoming file names on saving files (not important, which names - 1.csv to 100.csv is fully enough).
Please point me to right loops.Thanks.
Upd:
Based on advice from Tim Edwards i build up this macro:
Sub MyMacro()
Dim i As Integer, myname As String
myname = ThisWorkbook.Name
For i = 1 To 90
Windows(myname).Activate
Range("A" & i).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
ActiveSheet.Calculate
ActiveWorkbook.SaveAs Filename:= _
"Z:\file" & i & ".csv", FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWorkbook.Close True
Next i
End Sub
But the problem on it is, that the formulas in saved files aren't calculated - i get only the pasted formulas into a1.
Does somebody see the cause, why formulas aren't calculated before saving? I tried all kinds of formula calculation setting - automatic, manual, manual on saving.
Sub Makro1()
Dim i as integer
For i = 1 to 100
Windows("macrotest.xlsx").Activate
Range("A" & i).Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
ActiveWorkbook.SaveAs Filename:= "Z:\Mappe" & i & ".csv", FileFormat:=xlCSV, CreateBackup:=False
Next i
End Sub
Make one loop going from 1 to 90.
For i = 1 To 90
Next i
In each iteration:
Get the formula from Cells(i, 1).
Paste into a new workbook and calculate.
Save the workbook as "directory.." + i +".csv".