I have created a workbook which is named "AirHours" & the date from another workbook. I want to use this workbook throughout the entire project. The code below works, but I keep getting a run-time error 9 "Subscript out of range".
I'm trying to create a workbook for my report and have my data remain in its original form. The new workbook will be used in a number of modules. The runtime error seems to occur at SET WSD3=Workbook.
Maybe I going the wrong way on creating a public workbook. Thanks for your help.
Option Explicit
Public WSD3 As Workbook
Public Sub addNewWorkBook()
Dim NewName As String
Application.DisplayAlerts = False
NewName = "AirHours" & Workbooks("AirTimeWorkBookBeta").Worksheets("Data").Cells(2, 1).Value
Workbooks.Add
ActiveWorkbook.SaveAs NewName
Set WSD3 = Workbooks("NewName")
End Sub
Set WSD3 to your new workbook when you open it
Option Explicit
Public WSD3 As Workbook
Public Sub addNewWorkBook()
Dim NewName As String
Application.DisplayAlerts = False
NewName = "AirHours" & Workbooks("AirTimeWorkBookBeta").Worksheets("Data").Cells(2, 1).Value
Set WSD3 = Workbooks.Add
WSD3.SaveAs NewName
End Sub
Along with scott's suggestion, part of the problem is that when referencing workbooks with Workbooks("workbookname.ext") you need to provide the extension, like .xls or .xlsm, so you'll need to update the where you're referencing Workbooks("AirTimeWorkBookBeta") to include that workbook's appropriate extension.
You could also get the error if that workbook isn't currently open when the macro is run.
Additionally, make sure that workbook contains a sheet named Data
Related
I have a large Excel file (ORIGINAL.xlsm) with many sheets. I need to create automaticaly another file (COPY.xlsx), when I save the ORIGINAL.xlsm. The COPY.xlsx file should only contain 2 sheets (EXP1 and EXP2). But EXP1 and EXP2 must only contain values without formulas and ORIGINAL.xlsm may not be affected by this operations. I am trying to solve, but the original file is always negatively affected (formulas removed). I would like to avoid the use of ActiveWorkBook call because it is often operated with multiple open Excel.
Option Explicit
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim UserProfile As String
Dim Path As String
Dim NewBook2 As Workbook
UserProfile = VBA.Environ$("Userprofile")
Path = UserProfile & "\Dropbox\Program\COPY.xlsx"
Set NewBook2 = Workbooks.Add
NewBook2.SaveAs Filename:=Path
ThisWorkbook.Sheets("EXP1").Copy Before:=Workbooks("COPY.xlsx").Sheets(1)
ThisWorkbook.Sheets("EXP2").Copy Before:=Workbooks("COPY.xlsx").Sheets(2)
Workbooks("COPY.xlsx").Sheets("EXP2").Activate
Workbooks("COPY.xlsx").Sheets("EXP2").UsedRange.Select
Workbooks("COPY.xlsx").Sheets("EXP2").Copy Before:=Workbooks("COPY.xlsx").Sheets(2)
REM PROBLEM HERE
Workbooks("COPY.xlsx").UsedRange.Value = Workbooks("COPY.xlsx").UsedRange.Value
End Sub
You neither need the line with .Activate nor the line with .Select to make this code work. You might benefit from reading
How to avoid using Select in Excel VBA.
Note that your Workbooks("COPY.xlsx") is already set to NewBook2 so better use that variable just in case the name COPY.xlsx ever changes NewBook2 will always work.
Option Explicit
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim UserProfile As String
UserProfile = VBA.Environ$("Userprofile")
Dim Path As String
Path = UserProfile & "\Dropbox\Program\COPY.xlsx"
Dim NewBook2 As Workbook
Set NewBook2 = Workbooks.Add
NewBook2.SaveAs Filename:=Path
ThisWorkbook.Sheets("EXP1").Copy Before:=NewBook2.Sheets(1)
ThisWorkbook.Sheets("EXP2").Copy Before:=NewBook2.Sheets(2)
NewBook2.Sheets(2).UsedRange.Value = NewBook2.Sheets(2).UsedRange.Value
'here you need to save and probably close your new workbook
NewBook2.Close SaveChanges:=True 'or NewBook2.Save if you want to keep it open.
End Sub
The issue you had was that a workbook does not have a UsedRange like Workbooks("COPY.xlsx").UsedRange you need to specify a worksheet like NewBook2.Sheets(2).UsedRange.
This works for me... Thank you
I'm not too confident relative links in Excel as ActiveWorkbook or NewBook2.Sheets(2)
For this reason, open file names are in my code.
This best proved to work with more open Excel (for me).
Option Explicit
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim UserProfile As String
UserProfile = VBA.Environ$("Userprofile")
Dim path As String
path = UserProfile & "\Dropbox\Program\COPY.xlsx"
Dim NewBook2 As Workbook
Set NewBook2 = Workbooks.Add
NewBook2.SaveAs Filename:=path
ThisWorkbook.Sheets("EXP1").Copy Before:=Workbooks("COPY.xlsx").Sheets(1)
ThisWorkbook.Sheets("EXP2").Copy Before:=Workbooks("COPY.xlsx").Sheets(2)
Workbooks("COPY.xlsx").Sheets("EXP2").Activate
Workbooks("COPY.xlsx").Sheets("EXP2").UsedRange.Select
Workbooks("COPY.xlsx").Sheets("EXP2").UsedRange.Value = Workbooks("COPY.xlsx").Sheets("EXP2").UsedRange.Value
rem if file exists no alert display
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("COPY.xlsx").SaveAs Filename:=path
Workbooks("COPY.xlsx").Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I'm trying to duplicate a worksheet with a macro, but when doing so, to private sub is duplicated as well, what I don't want to happen because it interferes afterward with another module macro. I have seen this post Copy a worksheet without copying the code and tried, but it doesn't work properly. Some ideas on how to do that?
Sub Export()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Application.CutCopyMode = False
Sheets("CB").Select
MonthID = Range("N2").Value
YearID = Range("O2").Value
saldoID = Range("O18").Value
ActiveSheet.Unprotect
ActiveSheet.Copy After:=Sheets("CB")
' Get the code/object name of the new sheet...
Dim Code As String
Code = ActiveSheet.CodeName
' Remove all lines from its code module...
With ThisWorkbook.VBProject.VBComponents(Code).CodeModule
.DeleteLines 1, .CountOfLines
End With
The last step (.DeleteLines 1, .CountOfLines) always causes an error: "Can't enter break mode at this moment" - Run time error 1004 Application defined or object defined error.
Why, what is wrong or missing??
Thanks
One simple way:
copy sheet to new workbook
save new workbook as .xlsx
close new workbook
re-open new .xlsx workbook
copy the macro-free worksheet back to original workbook
The VBA code for this is simple; you could also include:
re-close the.xlsx
kill (delete) the .xlsx workbook
I have an Excel file that is updated every few seconds by an application. Using the data delivered by the application, several cells in the worksheet (called "TSdata") are calculated using various formulae. If the value of a specific cell (B41) changes, the macro should write the contents of the worksheet to a CSV file.
With the help of one of the guys on superuser.com, I created a version based on Worksheet_Change that worked perfectly if the content of the cell was manually updated. I created a version using Worksheet_Calculate that I expected to work the same way when the cell value was changed by the formula.
This is the code I used:
Private Sub Worksheet_Calculate()
If Worksheets(“TSdata”).Range(“B41”).Value<>prevval Then
Call ExportWorksheetAndSaveAsCSV
End If
prevval = Worksheets(“TSdata”).Range(“B41”).Value
End Sub
Public Sub ExportWorksheetAndSaveAsCSV()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Set shtToExport = ThisWorkbook.Worksheets("TSdata") 'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False 'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\TSCSV\TSCSV1.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
FileCopy "C:\TSCSV\TSCSV1.csv", "C:\ChartInfo\Data\TSCSV2.csv"
End Sub
I know from the earlier test using a manual update that the Public Sub works OK (It's copied from another query regarding writing CSV files) but when I launch the macro, it seems to attempt multiple updates (the screen blinks several times) and then crashes Excel. So, obviously something in the Private Sub is incorrect, but I've based it on other responses to similar questions, so I'm at a loss to figure out what's wrong/missing.
Note: the FileCopy at the end of the Public Sub is so that another program can work on the CSV without disrupting the Excel updates.
Thanks in advance for any help.
Copying a worksheet to no location creates a new workbook with a single worksheet that is a copy of the original.
Public Sub ExportWorksheetAndSaveAsCSV()
Dim fn1 As String, fn2 As String
fn1 = "C:\TSCSV\TSCSV1.csv"
fn2 = "C:\ChartInfo\Data\TSCSV2.csv"
'copying a ws to no location creates a new workbook with a single worksheet
ThisWorkbook.Worksheets("TSdata").Copy 'Sheet to export as CSV
Application.DisplayAlerts = False 'Possibly overwrite without asking
With ActiveWorkbook
.SaveAs Filename:=fn1, FileFormat:=xlCSV
.Close SaveChanges:=False
End With
Application.DisplayAlerts = True
On Error Resume Next
If CBool(Len(Dir(fn2))) Then Kill fn2
FileCopy fn1, fn2
On Error GoTo 0
End Sub
Good day all:
I'm trying to use a ActiveX command button to copy excel worksheets into another file. Here's the background:
I have excel log sheets that are being filled up every day. The logs have a set criterion (A, B, C, etc.) being run daily. While we still want to keep the logs in a daily file, I want a command button to be able to export to another workbook as a master file (e.g. "A_Masterfile", "B_Masterfile", etc.).
I've tried researching, but all these requirements come from different sites/pages. But since the method they use are so different, I'm having a hard time trying to get all Syntax to fit so that one code can do everything.
As a rundown, here's what I want it to do:
Export active worksheet to another workbook
a) If workbook exists, copy sheet to end of workbook
b) If workbook does not exist, create workbook and copy sheet
Destination workbook is based on a cell (criterion A, B, etc.)
Destination workbook might be in a different folder as source worksheet/workbook
Based on what I'm researching so far, this is what I'm turning up with.
When simply copying, this is what I read, but I could not get it to work.
ActiveSheet.Copy After:=Workbooks("Destination.xlsx").Worksheets(Worksheets.Count)
For Creating New File, this is what I read, but even from the original site, they said the problem was it copies the whole workbook, not just one specific sheet.
ActiveWorkbook.SaveAs "C:\path\Destination.xlsx"
Finally, I read about concatenation to create "Destination" file name based on a cell value. However, I got so lost with all the syntax. I tried simply copy pasting but I couldn't get it to work.
This is quite a bit to ask. Thanks so much in advance for all your help!
Please let me know if I can clarify anything.
P.S. Extra note: I've done some QBasic and MATLAB and a tiny bit of JAVA programming in school, so I got the logic part down. But I am quite new to VBA syntax, so extra information would be appreciated. :)
Update:
I just learned about "Record Macro" and I tried using it
I got this from it and it works:
Sheets("SourceSheet").Select
ActiveSheet.CheckBoxes.Add(639, 30, 58.8, 16.8).Select
ActiveSheet.CheckBoxes.Add(639.6, 44.4, 58.8, 16.8).Select
ActiveSheet.CheckBoxes.Add(639.6, 61.2, 58.8, 16.8).Select
ActiveSheet.OptionButtons.Add(1279.8, 37.8, 20.4, 18).Select
ActiveSheet.OptionButtons.Add(1280.4, 57, 21.6, 17.4).Select
Sheets("SourceSheet").Copy After:=Workbooks("DestinationMasterFile.xlsx").Sheets(1)
Windows("SourceWorkBook.xlsm").Activate
It works, but only put it after the first sheet instead of putting it in the end. I know it comes from the .Sheets(1), but I don't know how to write it otherwise. Thanks.
I have done a lot more research and trial and error, and I came up with a working code. This might be messy, but it works. Any further improvements are appreciated.
Private Sub CommandButton1_Click()
'Code for Locking
Sheets("W").Unprotect
Range("A1:BZ125").Locked = True
Sheets("W").Protect Password:="hello"
'Code for Copying
'Declarations
Dim Wk As Workbook
Dim FName As String
Dim FNameTwo As String
Dim FilePath As String
Dim TestStr As String
Dim wb As Workbook
'Initializing Constants
Set wb = ThisWorkbook
FName = "C:\Users\PHReyesDa\Desktop\" & Range("BO1") & ".xlsx"
FNameTwo = Range("BO1") + ".xlsx"
'If statement Setup (if exist)
FilePath = FName
TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
'If statement
If TestStr = "" Then
'If not existing, create new file
MsgBox "File didn't exist yet; new file created"
Set Wk = Workbooks.Add
Application.DisplayAlerts = False
Wk.SaveAs Filename:=FName
Application.DisplayAlerts = True
Workbooks(FNameTwo).Close SaveChanges:=True
End If
'Reopens Master File
Workbooks.Open FName
wb.Activate
'Find number of worksheets in destination workbook to worksheet could be copied to end of workbook
Dim Num As Integer
Num = Workbooks(FNameTwo).Worksheets.Count
'Copy source worksheet to (the end of) destination workbook
Sheets("W").Select
Sheets("W").Copy After:=Workbooks(FNameTwo).Worksheets(Num)
'Close and save new workbook, confirmation of successful copy
Workbooks(FNameTwo).Close SaveChanges:=True
MsgBox "Worksheet successfully exported and saved to master file"
End Sub
I am new to VBA. I have written a code to delete a particular sheet. After execution of that delete sheet macro, excel macro stopped execution. It didnt execute futher..
Here is my code..
Sub CopyAcross()
Dim sheetName As String
sheetName = "Master_Base"
If WorksheetExists(sheetName) Then
DeleteSheet (sheetName)
End If
MsgBox "Debug"
Workbooks("Master_Base.csv").Sheets("Master_Base").Copy Before:=Workbooks("Copy of test.xlsm").Worksheets("Sheet3")
End Sub
Sub DeleteSheet(strSheetName As String)
' deletes a sheet named strSheetName in the active workbook
Application.DisplayAlerts = False
Sheets(strSheetName).Delete
Application.DisplayAlerts = True
End Sub
Can any one help on this,
Thanks in advance.
I was experiencing the same issue, on a Windows 7 computer with Excel version 16.0.10730.20264 32-bit, the code ran fine without issue. However, on a Windows 10 computer with the same Excel install version, the macro would immediately stop execution following the Sheets.Delete line.
I found that this was only happening where I was attempting to manipulate a workbook that contained VBA code, that I had opened during the macro.
The issue is caused by the macro security settings on the computer. If you set Automation Security to Low before opening the workbook, you should no longer get the error:
Use the code:
Application.AutomationSecurity = msoAutomationSecurityLow
Since you are working with multiple workbooks, use objects. Else your code MAY work with the wrong workbook/worksheet
Try this (UNTESTED)
Sub CopyAcross()
Dim wbI As Workbook, wbO As Workbook
'~~> The workbook from where the code is running
Set wbO = ThisWorkbook
'~~> Here you open the csv
Set wbI = Workbooks.Open("E:\OPM\OPM Sheet\Master_Base.csv")
'~~> This will delete the sheet if it exists
'~~> no need to check if it exists
On Error Resume Next
Application.DisplayAlerts = False
wbO.Sheets("Master_Base").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'~~> The csv will always have 1 sheet
'~~> so no need providing a name
wbI.Sheets(1).Copy Before:=wbO.Worksheets("Sheet3")
End Sub