Hello thanks for reading my question, I have a Workbook with hidden templates and most of them are used as Excel .xlsx spreadsheet however one of them requires a module to be inserted for it to work. I thought simple enough just add a param to my function that creates the workbook.
It doesn't seem to work because i get an error "Error Number 1004 This extension can not be used with the selected file type. Change the file extension in the file name text box or select a different file type blabla"
Public Function gWrkBook(template As String, Optional wbMacro As Boolean) As Workbook
Dim wbNew As Workbook
Dim wsTemplate As Worksheet, wsSummary As Worksheet
Set wsTemplate = ThisWorkbook.Worksheets(template) '===== Create new workbook and copy template
wsTemplate.Visible = True
'
Set wbNew = Workbooks.Add 'Create New file
wsTemplate.Copy Before:=wbNew.Sheets(1) 'Copy template to new workbook
'Rename sheet
On Error GoTo ErrSheetName
wbNew.Sheets(1).Name = "SUMMARY"
Set wsSummary = wbNew.Sheets("SUMMARY")
wsTemplate.Visible = False '===== Clean up
Call gRemoveUnwanted("sheets", wbNew) 'Mod7 '==== Get SaveAs filename and save file
If wbMacro = True Then
vFileName = Application.GetSaveAsFilename(Filname, "Excel Macro-Enabled workbook(*.xlsm), *.xlsm", Title:="SaveAs Workbook Macro-Enabled")
Else
vFileName = Application.GetSaveAsFilename(FileFilter:="Microsoft Excel Workbooks, *.xlsx", Title:="SaveAs Workbook")
End If
On Error GoTo ErrFileName
wbNew.SaveAs Filename:=vFileName
Set gWrkBook = wbNew 'must assign it this way?? not sure why R2
Exit Function
ErrSheetName:
NewSheetName = InputBox("Worksheet exists, try a different name." & vbCrLf & "Enter Sheet Name.")
Resume
ErrFileName:
MsgBox "Error Number " & _
Err.Number & vbCrLf & _
Error(Err) & vbCrLf & _
"Try Again!", _
vbExclamation + vbOKOnly, _
"ERROR!"
vFileName = Application.GetSaveAsFilename(FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", _
Title:="SaveAs Workbook")
Resume
End Function
Try:
wbNew.SaveAs(Filename:=vFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled)
For more information, please read documentation:
VBA SaveAs
VBA File Format XlFileFormat Enumeration.
Related
I am new to excel VBA. I have already written VBA code to select any Excel file and copy path of that file to cell A1. Using the path I am trying to copy contents of source file, Sheet7, while retaining cell formatting i.e. bold, borders, colors, etc.
My first error is appearing for file path. Currently cell A1 value = C:\Users\Personal\Documents\Excel files\Dummy-Data - Copy.xlsx.
When I try to read value of A1 cell, VBA throws me an error "Sorry, we couldn't find. Is it possible it was moved, renamed or deleted?" and automatically clears the value of cell A1. But when I give the same path directly in VBA script, it works! Can someone tell me how to get this fixed?
My second doubt is around copying cell formats. When I use wksht.paste to paste copied content to Sheet2, it just pastes all cell values without formatting. But when I try to use PasteSpecial following error occurs- "Application-defined or object-defined error" . Can someone help me correct this please?
Sub Button1_Click()
' define variables
Dim lastRow As Long
Dim myApp As Excel.Application
Dim wbk As Workbook
Dim wkSht As Object
Dim filePath As Variant
'on error statement
On Error GoTo errHandler:
' Select file path
Set myApp = CreateObject("Excel.application")
Sheet2.Range("A1").Value = filePath
Set wbk = myApp.Workbooks.Open(filePath)
'Set wbk = myApp.Workbooks.Open("C:\Users\Personal\Documents\Excel files\Dummy-Data - Copy.xlsx")
' Copy contents
Application.ScreenUpdating = False
lastRow = wbk.Sheets(7).Range("A" & Rows.Count).End(xlUp).Row
wbk.Sheets(7).Range("A2:Q" & lastRow).Copy
myApp.DisplayAlerts = False
wbk.Close
myApp.Quit
' Paste contents
Set wbk = Nothing
Set myApp = Nothing
Set wbk = ActiveWorkbook
Set wkSht = wbk.Sheets("Sheet2")
wkSht.Activate
Range("A2").Select
wkSht.Paste
'wkSht.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.ScreenUpdating = True
Exit Sub
'error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please follow instruction sheet"
End Sub
My first error is appearing for file path. Currently cell A1 value = C:\Users\Personal\Documents\Excel files\Dummy-Data - Copy.xlsx. When I try to read value of A1 cell, VBA throws me an error "Sorry, we couldn't find. Is it possible it was moved, renamed or deleted?" and automatically clears the value of cell A1.
You're not setting a var's value to the value of a cell, you're setting the cell's value to a blank var thereby erasing the cell's value. It should be filePath = Sheet2.Range("A1").Value, (the reverse of what you have above).
When I use wksht.paste to paste copied content to Sheet2, it just pastes all cell values without formatting.
You're not just pasting between workbooks; you're pasting between workbooks open in separate application instances. You lose detail like formatting when pasting across instances. In any event, the separate Excel.Application seems wholly unnecessary.
Option Explicit
Sub Button1_Click()
' define variables
Dim lastRow As Long
Dim wbk As Workbook
Dim filePath As Variant
'on error statement
On Error GoTo errHandler:
' Select file path
filePath = Sheet2.Range("A1").Value
Set wbk = Workbooks.Open(filePath)
'Set wbk = Workbooks.Open("C:\Users\Personal\Documents\Excel files\Dummy-Data - Copy.xlsx")
' Copy contents & Paste contents
Application.ScreenUpdating = False
lastRow = wbk.Sheets(7).Range("A" & Rows.Count).End(xlUp).Row
wbk.Sheets(7).Range("A2:Q" & lastRow).Copy _
Destination:=Sheet2.Range("A2")
'shouldn't have to disable alerts
'Application.DisplayAlerts = False
wbk.Close savechanges:=False
'Application.DisplayAlerts = True
'
Application.ScreenUpdating = True
Exit Sub
'error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please follow instruction sheet"
End Sub
The naked worksheet codename references should be valid within ThisWorkbook.
I want to combine two csv into one new csv file via a vba macro but have problems accessing the values of the two files.
I can open the first file with Workbooks.Open() but I can not access any of its values by File1.ActiveSheet.Cells(1,1) or File1.ActiveSheet.Range(1,1) etc.
The catch is, that I have to open the second file through a path that is contained in the first file.
The Files look like this:
File1
File2
For every ID in File1 there is one File2 with about ~30000-60000 entrys that need to be mapped together.
My Idea was to copy File2 into the new File and than add the ID for every row.
I can not just change the File2 and ad the ID there since I have no writting rights to the Folder they are in.
The Struktur the Files are in at the Moment:
WorkingDir |
|___File1
|___Macro
|___allFile2
.........|__File2_1
.........|__File2_2
Is there a better approach to this?
I am new to vba programming and have almost no practise in it i would be really greatful if someone can help me or has some literatur that could help.
I would create another worksheet that can be used a medium for importation. What you would be doing is creating a macro that enables you to select another file from a open file window and then another macro that will copy and paste the desired data range. If you want to create a macro that integrates it into the other file you could do that as well.
Here is an example of how you might structure the File Select code:
Sub GetFile()
'Dim the variables
Dim FileSelect As Variant
Dim wb As Workbook
Dim i As Integer
'on error statement
On Error GoTo errHandler:
'hold in memory
Application.ScreenUpdating = False
'locate the file path
FileSelect = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*", _
MultiSelect:=False)
'check if a file is selected
If FileSelect = False Then
MsgBox "Select the file name"
Exit Sub
End If
'send the path to the worksheet
Sheet8.Range("C4").Value = FileSelect
'open the workbook
Set wb = Workbooks.Open(FileSelect)
'add the sheet names to the workbook
'close the workbook
wb.Close False
Application.ScreenUpdating = True
Exit Sub
This would be an example of your importation code:
Public Sub GetRange()
'Dim variables
Dim FileSelect As Variant
Dim wb As Workbook
Dim Addme As Range, _
CopyData As Range, _
Bk As Range, _
Sh As Range, _
St As Range, _
Fn As Range, _
Tb As Range, _
c As Range
'on error statement
On Error GoTo errHandler:
'hold values in memory
Application.ScreenUpdating = False
'check neccessary cells have values
For Each c In Sheet8.Range("C4,F4,G4,H4")
If c.Value = "" Then
MsgBox "You have left out a value that is needed in " & c.Address
Exit Sub
End If
Next c
'set the range reference variables
Set Bk = Sheet8.Range("C4") 'file path of book to import from
Set Sh = Sheet8.Range("G4") 'Worksheet to import
Set St = Sheet8.Range("G4") 'starting cell reference
Set Fn = Sheet8.Range("H4") 'finishing cell reference
'set the destination
Set Addme = Sheet8.Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
'open the workbook
Set wb = Workbooks.Open(Bk)
'set the copy range
Set CopyData = Worksheets(Sh.Value).Range(St & ":" & Fn)
'copy and paste the data
CopyData.Copy
Addme.PasteSpecial xlPasteValues
'clear the clipboard
Application.CutCopyMode = False
'close the workbook
wb.Close False
'return to the interface sheet
Sheet8.Select
End With
Application.ScreenUpdating = True
Exit Sub
'error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
This is merely an example of how you would structure it generally. You would need to build the excel worksheet for the references needed for the variables listed in the code.
A great resource for this subject is found at this website: http://www.onlinepclearning.com/import-data-into-excel-vba/
Hope this helps!
I have added a button in excel sheet and added following codes in vba window of that button. Now when I click this button i.e. when I run the codes it saves the excel sheet in pdf form whose name it takes from cell no H8 and saves it at M:\formats. Moreover it also saves the same excel sheet in .xlsx format at M:\formats\excels. But here the problem is when I run the codes it closes the excel sheet in which I have added the codes and opens the file which is saved by the codes. For example I made abc.xlsm excel sheet and added the codes in vb window, now xyz is written in cell no h8 in abc.xlsm excel sheet, now when I will run the codes it closes abc.xlsm and all codes are shown in xyz.xlsx excel sheet. I want it should only save the file in xlsx format it requisite location. It should not close the base file (which is abc.xlsx in the above example) and should not open the saved file (which is xyz.xlsx in the above example). Moreover I want that the saved file (xyz.xlsx in the above example) should not contain any vba coding. In another words it should be just like the backup copy for the base file (which is abc.xlsx in the above example). Kindly help me in to modify these codes to them as I want. I will be highly obliged to you. Thanks
Sub ExportAPDF_and_SaveAsXLSX()
Dim wsThisWorkSheet As Worksheet
Dim objFileSystemObject As New Scripting.FileSystemObject
Dim strFileName As String
Dim strBasePath As String
strBasePath = "M:\formats\"
strFileName = Range("H8")
On Error GoTo errHandler
Set wsThisWorkSheet = ActiveSheet
wsThisWorkSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strBasePath & strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
strBasePath = "M:\formats\excels\"
strFileName = Range("H8")
Application.DisplayAlerts = False
strFileName = objFileSystemObject.GetBaseName(strFileName) & ".xlsx"
wsThisWorkSheet.SaveAs Filename:=strBasePath & strFileName,
FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = False
MsgBox "Workbook now saved in XLSX format."
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Here is the code, with just two small changes. Both new sets of lines have the comment "New" in front of them.
Also just tidied up the error handling routine a little bit.
The way it works is this:
Store the filename of the current workbook in the variable 'strMasterWorkbookFilename'
The PDF file is created by 'exporting' the worksheet.
The Excel worksheet is then saved as an XLSX. This effectively 'closes' the original workbook.
3.1 The Button ("Button 8") is removed from the new XLSX worksheet and the workbook is saved again.
The code then re-opens the original workbook ('strMasterWorkbookFilename') and closes the current workbook.
Notes - Saving as the XLSX will remove the Macro code from the saved file. The Macro will remain in the main 'master' file.
Sub ExportAPDF_and_SaveAsXLSX()
Dim wsThisWorkSheet As Worksheet
Dim objFileSystemObject As New Scripting.FileSystemObject
Dim strFileName As String
Dim strBasePath As String
' NEW
Dim strMasterWorkbookFilename As String
strMasterWorkbookFilename = ThisWorkbook.FullName
strBasePath = "M:\formats\"
strFileName = Range("H8")
On Error GoTo errHandler
Set wsThisWorkSheet = ActiveSheet
wsThisWorkSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strBasePath & strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
Application.DisplayAlerts = False
strFileName = objFileSystemObject.GetBaseName(strFileName) & ".xlsx"
wsThisWorkSheet.SaveAs Filename:=strBasePath & strFileName, FileFormat:=xlOpenXMLWorkbook
wsThisWorkSheet.Shapes("Button 8").Delete
ActiveWorkbook.Save
Application.DisplayAlerts = False
MsgBox "Workbook now saved in XLSX format."
' NEW
Workbooks.Open strMasterWorkbookFilename
Workbooks(strFileName).Close SaveChanges:=False
exitHandler:
Exit Sub
errHandler:
MsgBox "Error Saving file. The error is " & vbCrLf & Chr(34) & Err.Description & Chr(34)
Resume exitHandler
End Sub
Thanks for posting this as a new question. If I'd carried on modifying the original code in the first question, it would not have been useful for anyone else reading your original post.
I am using the following VBA to save specific sheets. I would like to save the sheets at HTML. I tried changing the . xls to .html but all I get is gobby gook (technical term) Any help would be appreciated.
Option Explicit
Sub TwoSheetsAndYourOut()
Dim NewName As String
Dim nm As Name
Dim ws As Worksheet
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
With Application
.ScreenUpdating = False
' Copy specific sheets
' *SET THE SHEET NAMES TO COPY BELOW*
' Array("Sheet Name", "Another sheet name", "And Another"))
' Sheet names go inside quotes, separated by commas
On Error GoTo ErrCatcher
Sheets(Array("Copy Me", "Copy Me2")).Copy
On Error GoTo 0
' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select
' Remove named ranges
For Each nm In ActiveWorkbook.Names
nm.Delete
Next nm
' Input box to name new file
NewName = InputBox("Please Specify the name of your new workbook", "New Copy")
' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
ActiveWorkbook.Close SaveChanges:=False
.ScreenUpdating = True
End With
Exit Sub
ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub
Use Ron de Bruin's RangetoHTML code. Call it from within your For Each ws... loop
I found the solution,
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
ActiveWorkbook.SaveAs Filename:="C:**locationtosave**.html", FileFormat:=xlHtml
Hi I just embed this code into my vba macro, but how to change default directory when I use this macro.. for example when I click it is going to D:/myfolder
I found this code at google :
Sub Copy_ActiveSheet_2()
'Working in Excel 2000-2013
Dim fname As Variant
Dim NewWb As Workbook
Dim FileFormatValue As Long
'Check the Excel version
If Val(Application.Version) < 9 Then Exit Sub
If Val(Application.Version) < 12 Then
'Only choice in the "Save as type" dropdown is Excel files(xls)
'because the Excel version is 2000-2003
fname = Application.GetSaveAsFilename(InitialFileName:="", _
filefilter:="Excel Files (*.xls), *.xls", _
Title:="This example copies the ActiveSheet to a new workbook")
If fname <> False Then
'Copy the ActiveSheet to new workbook
ActiveSheet.Copy
Set NewWb = ActiveWorkbook
'We use the 2000-2003 format xlWorkbookNormal here to save as xls
NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
NewWb.Close False
Set NewWb = Nothing
End If
Else
'Give the user the choice to save in 2000-2003 format or in one of the
'new formats. Use the "Save as type" dropdown to make a choice,Default =
'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
" Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
" Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
" Excel 2000-2003 Workbook (*.xls), *.xls," & _
" Excel Binary Workbook (*.xlsb), *.xlsb", _
FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")
'Find the correct FileFormat that match the choice in the "Save as type" list
If fname <> False Then
Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
Case "xls": FileFormatValue = 56
Case "xlsx": FileFormatValue = 51
Case "xlsm": FileFormatValue = 52
Case "xlsb": FileFormatValue = 50
Case Else: FileFormatValue = 0
End Select
'Now we can create/Save the file with the xlFileFormat parameter
'value that match the file extension
If FileFormatValue = 0 Then
MsgBox "Sorry, unknown file extension"
Else
'Copies the ActiveSheet to new workbook
ActiveSheet.Copy
Set NewWb = ActiveWorkbook
'Save the file in the format you choose in the "Save as type" dropdown
NewWb.SaveAs fname, FileFormat:= _
FileFormatValue, CreateBackup:=False
NewWb.Close False
Set NewWb = Nothing
End If
End If
End If
End Sub
Change this part of the code
fname = Application.GetSaveAsFilename(InitialFileName:=""
to include the default save path you would like
fname = Application.GetSaveAsFilename(InitialFileName:=""C:\My Documents\"
Make sure you leave the trailing backslash, otherwise a default file will be suggested with a filename equal to the the path you have provided eg.
fname = Application.GetSaveAsFilename(InitialFileName:=""C:\My Documents"
Will result in a dialog where the default file named "My Documents" is saved in the location "C:\"