I have the following vba code which opens a Folder, where i save the Excel files with certain names ("11.xlsm and "2.xlsm") and then open These files automatically and copy their Sheets called "data" and paste it to my masterworkbook "makrotochange".
ChDir _
"Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA"
Workbooks.Open Filename:= _
"Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA\11.xlsm"
Workbooks.Open Filename:= _
"Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA\2.xlsm"
Windows("makrotochange.xlsm").Activate
Windows("11.xlsm").Activate
sheets("data").Select
sheets("data").Move After:=Workbooks("makrotochange.xlsm").sheets(23)
Windows("2.xlsm").Activate
sheets("data").Select
sheets("data").Move After:=Workbooks("makrotochange.xlsm").sheets(24)
I want to be able to open any amount of variable named files which is in
"Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA"
and copy/paste it to my "makrotochange.xlsm" masterworkbook.
How can i do this ?
Untested, as i am currently unable to use Excel. However, using the information you provided, and the link #Mrig provided, i believe this could be the base for what you're looking for.
Sub LoopThroughFiles()
Dim StrFile As String
Dim WB As Workbook
Dim InputFilePath As String
InputFilePath = "Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA\"
StrFile = Dir(InputFilePath & "*")
Do While Len(StrFile) > 0
Set WB = Workbooks.Open(InputFilePath & StrFile)
WB.Activate
Sheets("data").Select
Sheets("data").Move After:=Workbooks("makrotochange.xlsm").Sheets(23)
StrFile = Dir()
Loop
End Sub
EDITED
Edited the code now that i am able to use Excel.
This will take all the files in the folder, open them, copy the "Data" sheet, and move it to after sheet 23 in your makrotochange.xlsm file.
A few points of interest though.
You need to make sure that your makrotochange.xlsm file is open to begin with.
You need to make sure all files have a sheet called "Data".
They will be pasted after Sheet 23. So the last file to be pasted in will be the one next to sheet 23.
Have fun
Related
ive been working on some code for a while but cannot seem to get it to work.. think im nowhere near if im honest..
I want to program a button into an excel doc to go to a folder i.e. D:\Work\
which has lots of excel spreadsheets in, and save everyone one as a separate PDF doc?
thanks in advance
The code below Loop through all files and then save all worksheets with in a workbook as PDF. I have commented the code to help you understand it.
Option Explicit
Sub Loop_Dir_for_Excel_Workbooks()
Dim strWorkbook As String
Dim wbktoExport As Workbook
Dim strSourceExcelLocation As String
strSourceExcelLocation = "D:\Work\XLS\"
'Search all Excel files in the directory with .xls, .xlsx, xlsm extensions
strWorkbook = Dir(strSourceExcelLocation & "*.xls*")
Do While Len(strWorkbook) > 0
'Open the workbook
wbktoExport = Workbooks.Open(strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport)
'Get next workbook
strWorkbook = Dir
'Close Excel workbook without making changes
wbktoExport.Close False
Loop
End Sub
Sub Export_Excel_as_PDF(ByRef wbk As Workbook)
Dim strTargetPDFLocation As String
strTargetPDFLocation = "D:\Work\PDF\"
'Select all worksheets in the opened workbook
wbk.Sheets.Select
'Activate first worksheet
wbk.Sheets(1).Activate
'Export as PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strTargetPDFLocation & wbk.Name & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub
From a Personal.xlsb file, I want VBA to save the current active workbook as a user-definable name in the same directory and delete the original workbook.
Below is my code. It has two problems. One, it saves the workbook in My Documents folder for some reason. The active workbook is not in My Documents. It's in a folder in a completely different drive. Two, it throws a "File not found" error.
Sub RenameFile()
Dim thisWb As Workbook
Set thisWb = ActiveWorkbook
MyOldName = ActiveWorkbook.Name
MyNewName = InputBox("What do you want to rename the file as?", "Rename", ActiveWorkbook.Name)
ActiveWorkbook.SaveAs Filename:=thisWb.Path & MyNewName
Kill MyOldName
End Sub
You need to include a \ after path and before filename.
Sub RenameFile()
Dim thisWb As Workbook
Set thisWb = ActiveWorkbook
MyOldName = ActiveWorkbook.FullName
MyNewName = InputBox("What do you want to rename the file as?", "Rename", ActiveWorkbook.Name)
ActiveWorkbook.SaveAs Filename:=thisWb.Path & "\" & MyNewName
Kill MyOldName
End Sub
Edit: Updated answer to include fix from comment.
So I have some code that I use to auto save files (to a directory specified in the code) and then deletes a particular file type out of said folder. (I use it to save a .xlsx and delete .csv)
'Saves file to specified location
ActiveWorkbook.SaveAs filename:="C:\Desktop\Testing\Testing File " _
& Format(Now() - 1, "DD.MM.YY") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
On Error Resume Next
Kill "C:\Desktop\Testing*.csv*"
On Error GoTo 0
This is the code that I used that is within a longer VBA module, but you could incorporate this into existing VBA code
Take note that that currently saves the file as Testing with the day before the current system date in the name, such as "Testing 30.10.16"
I have a very similar question as this post:
Save individual Excel sheets as CSV
My question differs in that I only need one sheet to be saved
This is the answer from that post
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.SaveAs "C:\docs\" & ws.Name & ".csv", xlCSV
Next
This code saves each worksheet to a specific folder and names the file the same as the worksheet. 2 problems I see:
1- The workbook you were currently working on becomes the very last worksheet the code saved. If you want to keep working on your workbook you have to open the original file. It would work better if a new workbook was opened and saved separately from the one that is being worked on.
2- It saves each worksheet. I only need to save one specific worksheet, i.e Sheet2
I found this other code but I am VERY new to VBA and only know how to create a macro, copy & paste code into it. I get error when I run the code.
Sub test()
Application.DisplayAlerts = False
ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=strFullname, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
Hopefully I can get pushed in the right direction. Thanks!
strSourceSheet is the sheet which has the name/number of the sheet which you want to export
strFullname is the filename with path of the csv. As simple as that.
Now see this code
ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=strFullname, _
FileFormat:=xlCSV, _
CreateBackup:=True
ActiveWorkbook.Close
Let's say I want to copy Sheet2 then I would write it as
Dim strSourceSheet As String
Dim strFullname As String
'~~> Change the below two lines as per your requirements
strSourceSheet = "Sheet2"
strFullname = "C:\Temp\MyCsv.Csv"
ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=strFullname, _
FileFormat:=xlCSV, _
CreateBackup:=True
ActiveWorkbook.Close
Did you notice how we switch between ThisWorkbook and ActiveWorkbook. When you copy the sheet a new workbook is created and becomes active and hence to close that we use ActiveWorkbook
Hope this helps.
I appreciate there are lots of entries like save individual excel sheets as csv
and Export each sheet to a separate csv file - But I want to save a single worksheet in a workbook.
My code in my xlsm file has a params and data sheet. I create a worksheet copy of the data with pasted values and then want to save it as csv. Currently my whole workbook changes name and becomes a csv.
How do I "save as csv" a single sheet in an Excel workbook?
Is there a Worksheet.SaveAs or do I have to move my data sheet to another workbook and save it that way?
CODE SAMPLE
' [Sample so some DIMs and parameters passed in left out]
Dim s1 as Worksheet
Dim s2 as Worksheet
Set s1 = ThisWorkbook.Sheets(strSourceSheet)
' copy across
s1.Range(s1.Cells(1, 1), s1.Cells(lastrow, lastcol)).Copy
' Create new empty worksheet for holding values
Set s2 = Worksheets.Add
s2.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
' save sheet
s2.Activate
strFullname = strPath & strFilename
' >>> BIT THAT NEEDS FIXIN'
s2.SaveAs Filename:=strFullname, _
FileFormat:=xlCSV, CreateBackup:=True
' Can I do Worksheets.SaveAs?
Using Windows 10 and Office 365
This code works fine for me.
Sub test()
Application.DisplayAlerts = False
ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=strFullname, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
It's making a copy of the entire strSourceSheet sheet, which opens a new workbook, which we can then save as a .csv file, then it closes the newly saved .csv file, not messing up file name on your original file.
This is fairly generic
Sub WriteCSVs()
Dim mySheet As Worksheet
Dim myPath As String
'Application.DisplayAlerts = False
For Each mySheet In ActiveWorkbook.Worksheets
myPath = "\\myserver\myfolder\"
ActiveWorkbook.Sheets(mySheet.Index).Copy
ActiveWorkbook.SaveAs Filename:=myPath & mySheet.Name, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Next mySheet
'Application.DisplayAlerts = True
End Sub
You just need to save the workbook as a CSV file.
Excel will pop up a dialog warning that you are saving to a single sheet, but you can suppress the warning with Application.DisplayAlerts = False.
Don't forget to put it back to true though.
Coming to this question several years later, I have found a method that works much better for myself. This is because the worksheet(s) I'm trying to save are large and full of calculations, and they take an inconvenient amount of time to copy to a new sheet.
In order to speed up the process, it saves the current worksheet and then simply reopens it, closing the unwanted .csv window:
Sub SaveThisSheetInParticular()
Dim path As String
path = ThisWorkbook.FullName
Application.DisplayAlerts = False
Worksheets("<Sheet Name>").SaveAs Filename:=ThisWorkbook.path & "\<File Name>", FileFormat:=xlCSV
Application.Workbooks.Open (path)
Application.DisplayAlerts = True
Workbooks("<File Name>.csv").Close
End Sub
Here the Sheet and csv filename are hardcoded, since nobody but the macro creator (me) should be messing with them. However, it could just as easily be changed to store and use the Active Sheet name in order to export the current sheet whenever the macro is called.
Note that you can do this with multiple sheets, you simply have to use the last filename in the close statement:
Worksheets("<Sheet 1>").SaveAs Filename:=ThisWorkbook.path & "\<File 1>", FileFormat:=xlCSV
Worksheets("<Sheet 2>").SaveAs Filename:=ThisWorkbook.path & "\<File 2>", FileFormat:=xlCSV
[...]
Workbooks("<File 2>.csv").Close
I am working with Excel 2010, and have a userform which will support various processing options (i.e. sort by predefined ranges, get statistics, and the dreaded 'export' (SaveAs). I want to allow the user to export one of the sheets as either CSV or XLSX.
The issue is when I use the SaveAs to save as a CSV, it renames the sheet to the filename I selected (minus the extension). I have searched for hours and have not found any place that provides a solution. I did find a Stack 5+ year old post, but it didn't have a solution (see How to stop renaming of excelsheets after running the save macro)
Any help would be appreciated! Thanks!
Here is the code:
Dim ws As Excel.Worksheet
Dim strSaveName As String
Dim strThisName As String
strThisName = ThisWorkbook.Path & ThisWorkbook.Name
strSaveName = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.csv), *.csv")
Set ws = Worksheets("Export")
ws.SaveAs Filename:=strSaveName, FileFormat:=xlCSV
'I do the following TO UNDO THE RENAME <GROAN> (for now just saving as 0.csv)
Sheets("0").Name = "Export"
' Then the following is to regain my original filename since I will continue working...
ws.SaveAs Filename:=strThisName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Use ws.Copy with no args beforehand then save the new workbook
e.g. adapt your code to be like:
Dim ws As Excel.Worksheet
Dim strSaveName As String
strSaveName = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.csv), *.csv")
Set ws = Worksheets("Export")
'Copy the ws to a new workbook
ws.Copy
'With the new wb:
With Workbooks(Workbooks.Count)
'Save and close the new workbook
.SaveAs Filename:=strSaveName, FileFormat:=xlCSV
.Close False
End With
p.s. I assume you have code to handle clicking Cancel on GetSaveAsFilename and just removed it for clarity in the question ;)