I am generating a command button in access that will export data into Excel. At present, I have this function working and am trying to perfect it a little more such that each export will export the data onto a new sheet which will effectively be a copy of the ActiveSheet. The code that seems to be failing me is:
'Open workbook
Excel.Workbooks.Open "\\aos03s-fp04\brewsti2$\Alarms\ExportTest - " & Format(Now(), "dd-mm-yyyy") & ".xlsx", True, False
'Copy initial activesheet
ActiveSheet.Copy Before:=Excel.Sheets("Sheet2")
'Rename new copied sheet
ActiveSheet.Name = Me.RAW_TAG
The code fails on the ActiveSheet.Copy function. Any ideas?
Access has in build Command button procedure to Export Table to Excel. But, anyway, you can use this one:
Dim outputFileName As String
outputFileName = CurrentProject.Path & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Table1", outputFileName , True
Try this, alternatively:
Sub CopySheet()
Dim MySheetName As String
MySheetName = "TestSheet" Sheets("MasterSheet").Copy After:=Sheets("MasterSheet")
ActiveSheet.Name = MySheetName
End Sub
Try this, alternatively:
Sub CopySheet()
Dim MySheetName As String
MySheetName = "TestSheet" Sheets("MasterSheet").Copy After:=Sheets("MasterSheet")
ActiveSheet.Name = MySheetName
End Sub
Assuming this code is running in MS Access VBA, and Excel is an Excel Application object, you need to specify that ActiveSheet is a property of that Application object:
'Open workbook
Excel.Workbooks.Open "\\aos03s-fp04\brewsti2$\Alarms\ExportTest - " & Format(Now(), "dd-mm-yyyy") & ".xlsx", True, False
'Copy initial activesheet
Excel.ActiveSheet.Copy Before:=Excel.Sheets("Sheet2")
'Rename new copied sheet
Excel.ActiveSheet.Name = Me.RAW_TAG
Related
I am very new to vba/macros, I created a macro that splits multiple sheets into new excel file. However, I get 1004 error when I run the macro.
Below is my code.
Private Sub CommandButton2_Click()
Dim workbookPath As String
workbookPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each wSheet In ThisWorkbook.Sheets
wSheet.Copy
Application.ActiveWorkbook.SaveAs Filename:=workbookPath & "C\Path.xlsm" & wSheet.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Note macro button I have created in sheet1 named "Part1" and want to create new files from next sheet onwards. Please help....
You are trying to insert two paths into your line of code.
Since you defined the workbookPath variable you don't need to use "C\Path.xlsm". You need to remove "C\Path.xlsm" and insert "\" before wSheet.Name. see basic code below.
Comment out the Debug.Print(s) after you have used to verify.
Dim workbookPath As String: workbookPath = ThisWorkbook.Path 'ThisWorkbook is the macro enabled workbook.
Debug.Print ThisWorkbook.Path 'open the immediate window to varify to verify the path of the macro enabled workbook.
For Each wSheet In ThisWorkbook.Sheets
wSheet.Copy
ActiveWorkbook.SaveAs Filename:=workbookPath & "\" & wSheet.Name & ".xlsx"
'When you save a sheet as a workbook it becomes the activeworkbook
Debug.Print ActiveWorkbook.Path & "\"; ActiveWorkbook.Name 'use to verify the path of the new workbook.
ActiveWorkbook.Close False
Next wSheet
End Sub
I'm relatively new to VBA. I worked on the following code, which workED perfectly until I decided to filter for non-blanks before saving the sheet.
The idea is to save my sheet in the same path after filtering out any blank values. The new file will be values only in CSV. Again, all of that worked, except when it comes to filtering the data and saving the file.
Now I get the
"Run-time error 438 Object doesn’t support this property or method"
on the code below
ThisWorkbook.Sheets("SHEET1").SpecialCells(xlCellTypeVisible).Copy
The full code
Private Sub CommandButton1_Click()
If Sheets("SHEET1").AutoFilterMode Then Sheets("SHEET1").AutoFilterMode = False
sDate = Format(Sheets("SHEET2").Range("F1"), "YYYY.MM.DD")
cell = "NAME - " & sDate
ThisWorkbook.Sheets("SHEET1").Range("A:C").AutoFilter Field:=2, Criteria1:="<>"
ThisWorkbook.Sheets("SHEET1").SpecialCells(xlCellTypeVisible).Copy
With ActiveSheet.UsedRange
.Value = .Value
End With
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & cell & ".csv", FileFormat:=xlCSV
End Sub
Please read the code's comments and adjust it to fit your needs
EDIT: Adjusted a type in this row sourceSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy targetWorkbook.Worksheets(targetWorkbook.Sheets.Count).Range("A1")
Private Sub CommandButton1_Click()
Dim targetWorkbook As Workbook
Dim sourceSheet As Worksheet
Dim formatDate As String
Dim fileName As String
Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
' Remove filter
If sourceSheet.AutoFilterMode Then sourceSheet.AutoFilterMode = False
If sourceSheet.Range("F1").Value <> vbNullString Then
formatDate = Format(sourceSheet.Range("F1").Value, "YYYY.MM.DD")
End If
' Set the new workbook file name
fileName = "NAME - " & formatDate
' Filter the fileNames
sourceSheet.Range("A:C").AutoFilter Field:=2, Criteria1:="<>"
' Add new workbook and set reference
Set targetWorkbook = Workbooks.Add
' Copy the visible fileNames in a new workbook
sourceSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy targetWorkbook.Worksheets(targetWorkbook.Sheets.Count).Range("A1")
' Save the new workbook
targetWorkbook.SaveAs ThisWorkbook.Path & "\" & fileName & ".csv", FileFormat:=xlCSV
End Sub
Let me know if it works
I want to copy multiple sheets from one workbook(4 out of 14) but i'm starting with one("Data"). I want to rename the workbook based on a cell in the first workbook. with this code I get an "run-time error '1004' Excel cannot access the file 'C:\3B4DD....
my code so far:
Sub Newyeartest()
sheetstocopy = "data"
Worksheets(sheetstocopy).Copy
Dim FName As String
Dim FPath As String
FPath = "C:"
FName = Sheets("data").Range("A1") & ".xlsm"
ThisWorkbook.SaveAs Filename:=FPath & "\" & FName, FileFormat:=52
End sub
If I delete the "Fileformat:=52" It seems to go better but I get a text that this file must be saved as an macro enabled file. But I would guess that "Xlsm" is macro enabled?
Instead of copying worksheets, the better way is to copy the workbook with all the worksheets and then delete the ones that are not needed.
The code saves the workbook first, using the path of the current workbook;
Then it starts checking every worksheet, making sure that the name is not "data";
If the name is not "data" and there are more than 1 worksheets left, it deletes the worksheet;
The Application.DisplayAlerts = False is needed, in order to remove the msgbox for confirmation of the deletion of the worksheet. Then the Alerts are back set to True;
If the name is not "data" and this is the last worksheet, it gives a MsgBox "Last worksheet cannot be deleted!", as far as a workbook should always have at least 1 worksheet, by design;
Sub NewTest()
ThisWorkbook.SaveAs ThisWorkbook.Path & "\new.xlsm"
Dim sheetToCopy As String: sheetToCopy = "data"
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If wks.Name <> sheetToCopy Then
If ThisWorkbook.Worksheets.Count > 1 Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(wks.Name).Delete
Application.DisplayAlerts = True
Else
MsgBox "Last worksheet cannot be deleted!"
End If
End If
Next wks
End Sub
This should do the trick:
Option Explicit
Sub Newyeartest()
Dim wb As Workbook
Dim SheetNames As Variant, Key As Variant
Dim FName As String, FPath As String
Application.ScreenUpdating = False
SheetNames = Array("data", "data2", "data3", "data4") 'store the sheet names you want to copy
Set wb = Workbooks.Add 'set a workbook variable which will create a new workbook
'loop through the sheets you previously stored to copy them
For Each Key In SheetNames
ThisWorkbook.Sheets(Key).Copy After:=wb.Sheets(wb.Sheets.Count)
Next Key
'delete the first sheet on the new created workbook
Application.DisplayAlerts = False
wb.Sheets(1).Delete
FPath = "C:\Test"
FName = ThisWorkbook.Sheets("data").Range("A1") & ".xlsm"
wb.SaveAs Filename:=FPath & "\" & FName, FileFormat:=52
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
You cannot save directly to C:\ so you need to create a folder and the code will work.
I'm trying to copy a worksheet data and save it in a new worksheet without copying the underlying formulas from the original sheet(shtAnalysis). I'm unable to do that as I'm getting error:
Paste Special Method of Range class failed
at the line
wsPaste.UsedRange.PasteSpecial xlPasteValues.
Public Sub PrepareFileAttachment()
Application.CalculateFull
Dim wrkBook As Workbook, wsPaste As Worksheet
Dim Path As String
Set wrkBook = Workbooks.Add
Set wsPaste = wrkBook.Worksheets(1)
Path = "C:\RandomPath" & "\" & "Report" & Format(Now, "mmddyyyy")
shtAnalysis.Copy
wsPaste.Activate
wsPaste.UsedRange.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ActiveWorkbook.SaveAs filename:=Path, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
shtControl.Range(GENERATED_FILENAME).Value = Path & ".xlsx"
ActiveWindow.Close
End Sub
Avoid the Activate and the Used.Range, thus, change these lines:
shtAnalysis.Copy
wsPaste.Activate
wsPaste.UsedRange.PasteSpecial xlPasteValues
To these:
shtAnalysis.Copy
wsPaste.PasteSpecial xlPasteValues
The original code is trying to copy the whole worksheet shtAnalysis, but is allowed to paste it only in the UsedRange, which is something that VBA does not like.
Please give this a try
Public Sub PrepareFileAttachment()
Application.CalculateFull
Dim wrkBook As Workbook, wsPaste As Worksheet
Dim openedWorkbook As Workbook
Dim Path As String
Set openedWorkbook = ThisWorkbook
Set wrkBook = Workbooks.Add
Set wsPaste = wrkBook.Worksheets(1)
Path = "C:\RandomPath" & "\" & "Report" & Format(Now, "mmddyyyy")
openedWorkbook.Sheets("shtAnalysis").Copy
wsPaste.Activate
wsPaste.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ActiveWorkbook.SaveAs Filename:=Path, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
shtControl.Range(GENERATED_FILENAME).Value = Path & ".xlsx"
ActiveWindow.Close
End Sub
I'm new to VBA and stuck on an issue. I'm trying to copy a table to a .csv file and I want the end result to contain the original .xlsm name & the table name and date/time. I've successfully pieced together code to export the table to .csv with the table name and date/time but I'm struggling to get the file mane in there. I get the following error "Method 'SaveAs' of object'_Workbook' failed"
Below is what I have, any help would be great!
Sub ExportTableBanquetEarnings()
Application.ScreenUpdating = False
Sheets("BanquetEarnings").Visible = True
Sheets("BanquetEarnings").Select
Dim wb As Workbook, wbNew As Workbook
Dim ws As Worksheet, wsNew As Worksheet
Dim wbNewName As String
Dim wbCurrent As String
wbCurrent = ThisWorkbook.FullName
Set wb = ThisWorkbook
Set ws = ActiveSheet
Set wbNew = Workbooks.Add
With wbNew
Set wsNew = wbNew.Sheets("Sheet1")
wbNewName = ws.ListObjects(1).Name
ws.ListObjects(1).Range.Copy
wsNew.Range("A1").PasteSpecial Paste:=xlPasteAll
.SaveAs Filename:="F:\admin\Report Databases\BanquetTipouts" & "\" &
wbCurrent & wbNewName & Format(Now, "yyyymmdd_hhmm") & ".csv", _
FileFormat:=xlCSVMSDOS, CreateBackup:=False
End With
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
ActiveWorkbook.RefreshAll
Sheets("BanquetEarnings").Visible = False
Sheets("Blank Cost Sheet").Select
Workbooks.Open "F:\Function Agreements\Cost Sheets M\Payroll Report -
V2.xlsm"
End Sub
The below code will show the path of that Workbook
wbCurrent = ThisWorkbook.FullName
I think what you meant to use is...
wbCurrent = ThisWorkbook.Name
Also, I think another issue might be the Now method, it should be as Now()