When I create a new Workbook and add sheets to it using another Workbook, the sheets appear in the workbook window but VBA does not recognize them - vba

So what I am trying to do is to create a new workbook every year. A new workbook gets created if there is data from two different years in a certain worksheet of the workbook. When it sees two different years, it creates a new workbook, imports the .bat file into the new workbook, then pastes the information from the new year into the new workbook from the old workbook. Then it adds three more sheets and names them the same way they were named in the old workbook. The problem I am running into is when I run the macro for the new workbook, it says that "Sheet2" is Empty and then throws an error. I know all 4 sheets are there because I see them being added when I have trued to debug the code. But when I go into the VBA editer, all I see under the Microsoft Excel Objects folder is "Sheet1(...) and ThisWorkbook. It should show "Sheet1(...)","Sheet2(...)","Sheet3(...)", and "Sheet4(...)". So something is not being transferred into the VBA editor from the new workbook.
I have tried transferring the old data into another workbook and importing the macro to see if it was workbook specific (it wasn't). I have tried creating a loop to activate each sheet when it runs the macro in the new workbook to see if VBA would recognize it then, and adding a delay before and after I save the new workbook after all the sheets are added using the old workbook macro:
I am trying to avoid having to majorly rewrite it.
Sub NewYearNewFile(WashN As Variant, savepathname As String, FileYearNumber As Variant) 'This sub is to avoid crossover of data from multiple years in one spreadhseet
'After copy and paste is complete, then compare the years on sheet one and copy next years data over to a new worksheet--------
Dim NextRow As Integer, FinalColumn As Integer, FinalYear As String
Dim i As Long, newworkbook As Workbook, NextRow4 As Integer
Dim VBProj As Object
Dim savepath As String
Dim FileName As String
Sheet1.Activate 'activates sheet 1
NextRow = Cells(Rows.Count, 1).End(xlUp).Row 'Find the last row# of important data
FinalColumn = Cells(1, Columns.Count).End(xlToLeft).Column 'finds the rightmost column
FinalYear = Year(Sheet1.Cells(NextRow, 1).Value) 'finds the year in the final row and uses this for the new filename
NextRow4 = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row 'Find the last row# of important data
'the folderpath of the Master Macro File (used when createing a new excel file)
Dim MMacroFilePath As String 'defines and states the filepath of the stored macto to import
MMacroFilePath = "L:\MCP\Conformal Coat & Wash\Aquastorm50\DataLogs\Compiled data" & _
"\Automated Files\THE ULTIMATE MACRO.bas" 'the macro filepath
FileName = "Wash " & WashN & " Data " & FinalYear & ".xlsm" 'saved filename format
savepath = savepathname & FileName 'complete file path of the saved excel file
'Compare the final year of recorded data to the year number in the filename. If they are not the same, do the following.
'If they are the same, do nothing and finish the copy and paste portions of the code.
If FinalYear <> FileYearNumber Then
'Go to the row 200 before the last one, and begin comparing dates.
For i = NextRow - 200 To NextRow 'from 200 lines up from the bottom to the bottom row
If Year(Sheet1.Cells(i, 1).Value) <> CInt(FileYearNumber) Then 'if the year in this row doesnt match the file name year
Cells(i, 1).Resize(NextRow - i + 1, FinalColumn).Cut 'cut this row and all rows below it
Set newworkbook = Workbooks.Add 'create a new workbook
newworkbook.Activate 'activate this workbook
Set VBProj = Nothing 'clearing the variable
Set VBProj = ActiveWorkbook.VBProject 'defines the variable
VBProj.VBComponents.Import MMacroFilePath 'imports this macro into the new workbook
With newworkbook
.Sheets("Sheet1").Paste 'pastes it to the first sheet in the new file
.Sheets("Sheet1").Rows(1).EntireRow.Insert 'adds a new row for headers when they get inserted later
.Sheets(1).Name = Sheet1.Name
.Sheets.Add 'add sheet2 to the workbook
.Sheets(1).Name = Sheet2.Name
.Sheets.Add 'add sheet3 to the workbook
.Sheets(1).Name = Sheet3.Name
.Sheets.Add 'add sheet4 to the workbook
.Sheets(1).Name = Sheet4.Name
End With
GoTo CCheck: 'tells the code to skip looping and goto the end of the sub
End If
Next i
'This moves any data from the Chem Check sheet to the new workbook
CCheck: 'once the data from sheet one moves over, the code goes here
For i = NextRow4 - 8 To NextRow4 'from 8 lines up from the bottom to the bottom row
If IsDate(Sheet4.Cells(i, 1).Value) And Year(Sheet4.Cells(i, 1).Value) <> CInt(FileYearNumber) Then 'if the year in this row doesnt match the file name year
Sheet4.Cells(i, 1).Resize(NextRow4 - i + 1, FinalColumn).Cut 'cut this row and all rows below it
newworkbook.Activate 'activate the new workbook
With newworkbook
.Sheets("sheet4").Paste 'pastes it to the fourth sheet in the new file
.Sheets("Sheet4").Rows(1).EntireRow.Insert 'adds a new row for headers when they get inserted later
End With
GoTo Finish: 'tells the code to skip looping and goto the end of the sub
End If
Next i
Finish: 'the code goes here after it reachers "Goto Finish:"
Application.Wait Now + #12:00:01 AM#
newworkbook.SaveAs savepath, 52 'saves new file with the Filepath for the new spreadsheet (52 means ".xlsm")
Application.Wait Now + #12:00:01 AM#
newworkbook.Close 'closes the new workbook
End If
End Sub

.Sheets.Add 'add sheet4 to the workbook
.Sheets(1).Name = Sheet4.Name
Sheets.Add is a function that returns a reference to the added sheet - you're discarding it. Instead, you need to capture it. Declare a Sheet4 variable of type Worksheeet, and set its reference:
Dim Sheet4 As Worksheet
Set Sheet4 = .Sheets.Add
The problem is that you're assuming that the compiler can understand what's happening at run-time.
It doesn't. The compiler doesn't care about what happens at run-time, it only knows about code and objects that exists at compile-time. The VBA runtime/interpreter cares about run-time.
If Sheet4 doesn't exist at compile-time, then VBA doesn't define a global-scope Sheet4 object variable for you, so referring to Sheet4 in code will inevitably result in code that can't be compiled (and thus can't be executed), at least if Option Explicit is specified.
Without Option Explicit, what's happening is quite more complex.
I presume you're getting an "Object required" run-time error, on the first instruction that refers to any member of a worksheet object that you've created at run-time.
The reason is because without Option Explicit, at compile-time there's no identifier validation, so any typo will happily be compiled. At run-time, when VBA encounters an undeclared variable, it simply defines one on-the-spot, as an implicit Variant that can hold literally anything. Except it won't go as far as to infer that this on-the-fly variable is an object with members - so the runtime blows up and says "I've no idea what this is, it should be an Object, but I'm looking an a Variant/Empty".
TL;DR: Specify Option Explicit, and declare a variable for every identifier the compiler complains about (via the Debug ~> Compile VBAProject menu), until the code compiles correctly.
The global object variables (e.g. Sheet1, Sheet2, etc.) you're assuming "come for free with every worksheet" only exist if the object exists at compile-time.

Related

VBA to paste data into existing workbook without specifying workbook name?

I am creating a workbook which will be used as a template for monthly reports (let's call it 'ReportWorkbookTest') and am struggling to write or record a macro which will paste data into the ReportWorkbookTest from various, unspecified workbooks.
To create the monthly reports, data is exported from a server to a .xlsx file named by the date/time the report was exported. Therefore, the name of the workbook which information will be pasted form will always have different names. The columns that the information in the monthly data exports will always remain the same (columns D:G & I). I've managed to do this for two specified workbooks but cannot transpose to new monthly data exports.
Range("I4").Select
Windows("Export 2018-06-21 11.51.34.xlsx").Activate
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=9, Criteria1:= _
xlFilterLastMonth, Operator:=xlFilterDynamic
Range("D2:G830,I2:I830").Select
Range("I2").Activate
Selection.Copy
Windows("ReportWorkbookTest.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Is there a way to set up the VBA so that the workbook names do not need to be specified while running the macro? Also, how do I specify that the macro only copies the active rows in the table if the number of rows changes per export?
Thanks!
If only these two workbooks will be open you can use numbers instead of the name:
Workbooks(1)
and
Workbooks(2)
Workbooks(1) will be the one that was opened first, more likely ReportWorkbookTest.xlsm where the macro will be, so you can provide instructions that this file should be opened first. If more than these two workbooks will be open you can try a loop approach, here is an example to use:
Dim wkb as Workbook
Dim thisWb as Workbook
Dim expWb as Workbook
Set thisWb = ThisWorkbook
For Each wkb in Workbooks
If wkb.Name Like "Export 2018-*" Then
expWb = wkb
Exit For
End If
Next
If Not expWb Is Nothing Then
'Found Export, do stuff like copy from expWb to thisWb
expWb.Worksheets(1).Range("B20:B40").Copy
thisWb.Sheets("PasteSheet").Range("A3").PasteSpecial xlValues
Else
'Workbook with Export name not found
End If
This is your framework, if you have multiple files to import then I would suggest a wizard instead.
Wizard framework would be:
1) prompt the user to select a file (of a certain type you might check for, can be a column name - header)
2) if it passes validation then import the data (and process it)
2b) if doesn't pass report it wasn't a valid file and prompt again
3) prompt for the next file type
......
I have a project like this that takes 4 different data "dumps" and merges them into a summary workbook each month.
But for a single file of changing name, here you go for a framework:
you can eliminate cycling through all of the worksheets if there is only one
you might also not be appending data to what already exists, but that is what finding the new last row is for.
Option Explicit
'Sub to get the Current FileName
Private Sub getFN()
Dim Finfo As String
Dim FilterIndex As Long
Dim Title As String
Dim CopyBook As Workbook 'Workbook to copy from
Dim CopySheet As Worksheet 'Worksheet to copy from
Dim FN As Variant 'File Name
Dim wsNum As Double 'worksheet # as you move through the Copy Book
Dim cwsLastRow As Long 'copy worksheet last row
Dim mwsLastRow As Long 'master worksheet last row
Dim masterWS As Worksheet 'thisworkbook, your master worksheet
Dim rngCopy1 As Range
Dim rngCopy2 As Range
Set masterWS = ThisWorkbook.Worksheets("Master Security Logs")
'Set up file filter
Finfo = "Excel Files (*.xls*),*.xls*"
'Set filter index to Excel Files by default in case more are added
FilterIndex = 1
' set Caption for dialogue box
Title = "Select the Current AP Reconcile Workbook"
'get the Forecast Filename
FN = Application.GetOpenFilename(Finfo, FilterIndex, Title)
'Handle file Selection
If FN = False Then
MsgBox "No file was selected.", vbExclamation, "Not so fast"
Else
'Do your Macro tasks here
'Supress Screen Updating but don't so this until you know your code runs well
Application.ScreenUpdating = False
'Open the File
Workbooks.Open (FN)
'Hide the file so it is out of the way
Set CopyBook = ActiveWorkbook
For wsNum = 1 To CopyBook.Sheets.Count 'you stated there will be 8, this is safer
'Do your work here, looks like you are copying certain ranges from each sheet into ThisWorkbook
CopySheet = CopyBook.Worksheets(wsNum) '1,2,3,4,5,6,7,8
'Finds the lastRow in your Copysheet each time through
cwsLastRow = CopySheet.Cells(CopySheet.Rows.Count, "A").End(xlUp).Row
'Set your copy ranges
Set rngCopy1 = CopySheet("D2:D"&cwsLastRow) 'this is your D column
Set rngCopy2 = CopySheet("I2:I"&cwsLastRow) 'this is your I column
'so you would have to keep tabs on what the lastRow of this sheet is too and always start at +1
mwsLastRow = masterWS.Cells(masterWS.Rows.Count, "A").End(xlUp).Row
'Copy the ranges in where you want them on the master sheet
'rngCopy1.Copy destination:= masterWS.Range("D"&mwsLastRow+1)
'rngCopy2.Copy destination:= masterWS.Range("I"&mwsLastRow+1)
'Clear the clipboard before you go around again
Application.CutCopyMode = False
Next wsNum
End If
'Close the workbook opened for the copy
CopyBook.Close savechanges:=False 'Not needed now
'Screen Updating Back on
Application.ScreenUpdating = True
End Sub

Excel loop macro ending early and needing to keep files open to copy several loops(different files)

I'm having a bit of a problem with this VBA code
Sub upONGOING_Train1()
ScreenUpdating = False
'set variables
Dim rFndCell As Range
Dim strData As String
Dim stFnd As String
Dim fCol As Integer
Dim oCol As Integer
Dim SH As Worksheet
Dim WS As Worksheet
Dim strFName As String
Dim objCell As Object
Set WS = ThisWorkbook.Sheets("Trains")
For Each objCell In WS.Range("L3:L100")
oCol = objCell.Column
strFName = WS.Cells(, oCol).Offset(objCell.Row - 1, 0)
On Error GoTo BLANK: 'skip macro if no train
Workbooks.Open Filename:=strFName 'open ongoing report
Set SH = Worksheets("Trains") 'set sheet
stFnd = WS.Cells(, oCol).Offset(objCell.Row - 1, 2).Value 'set connote
With SH
Set rFndCell = .Range("C3:C1100").Find(stFnd, LookIn:=xlValues)
If Not rFndCell Is Nothing Then
fCol = rFndCell.Column
WS.Cells(, oCol).Offset(objCell.Row - 1, 3).Resize(1, 6).Copy
SH.Cells(, fCol).Offset(rFndCell.Row - 1, 10).Resize(1, 6).PasteSpecial xlPasteValues 'paste values in ongoing report if connote found
ActiveWorkbook.Save 'save ongoing report
ActiveWorkbook.Close 'close ongoing report
Else 'Can't find the item
End If
End With
BLANK:
Next objCell
ScreenUpdating = True
End Sub
What I want it to do is - for every row in L3:L100
Open file listed in column "L" (if there or skip line to next one) and go to sheet
Match value from original sheet column "N" to "C3:C1100" in newly opened sheet
Copy columns "O:T" and paste relative to the matching value in the opened sheet(M:R) and save
However when I leave a gap of 2 rows it gives me the error for file not found instead of proceeding to the next loop like it does when there is only 1 row missing.
Seems i can't post images yet.
Also if anyone can point me in a good direction on how to open the sheet in the cell reference only if it is not already open it will usually only have 2 files to use (max of 4 at end of quarter).
Its just too much trouble to click OK on all the windows that pop up when you try to reopen an already open workbook.
If its any help to get your head around it.
I have 2 separate reports for 2 clients(new each quarter so max of 4 sheets at a time) that will already have the names to be searched (2 sheets in each book).
Any help would be greatly appreciated
Thanks heaps
Thanks to those who have put forth suggestions and code.
I'll them out tomorrow and failing that I've just come up with another idea that to re-purpose some other code I have but didn't realize would help.
The code basically copies what I need to a blank tab and deletes rows with a given value - with some formulas to help sort this would give me a block of rows with no breaks all going to the same destination file.
Thus allowing me to run the (a bit more streamlined Thanks everyone) loop over the remaining rows.
On Error GoTo BLANK
Workbooks.Open Filename:=strFName
Change the above into this:
On Error Resume Next
Workbooks.Open Filename:=strFName
If Err.Number <> 0 Then Goto Blank
As to hpw keep the workbook open, you can leave it open (no .close) but then when you want to open it check first if it is open (i.e. using Workbooks("name")), with some error handling using the same mechanism as above, if error exists then the wb is not already open, you open it.
Finally, avoid counting on the Active stuff, such as the ActiveWorkbook`. Instead, make an explicit reference to you wb, i.e.:
Set wb = Workbooks.Open(Filename:=strFName)
Set SH = wb.Worksheets("Trains")
to consider only not blank cells you can use SpecialCells() method of Range object and leave off any On Error GoTo statements, that should be used in very a few limited cases (one of which we'll see in a second)
furthermore you're using some uselessly long winded 'loops' to reference your relevant cells, for instance:
WS.Cells(, oCol).Offset(objCell.Row - 1, 0)
is equivalent to objCell itself!
and there are some more examples of that kind
finally, let's come to the workbooks open/close issue
you could:
use a Dictionary object to store the name of all opened workbooks so as to leave then open throughout your macro and close them all by the end of it
adopt a helper function that tries to set the wanted sheet (i.e. "Trains") in the wanted workbook (i.e. the one whose name is the current objCell value) and return False if not successful
all what above in this refactoring of your code:
Sub upONGOING_Train1bis()
Dim rFndCell As Range
Dim SH As Worksheet
Dim objCell As Range
Dim shtDict As New Scripting.Dictionary '<--| this is the dictionary that will store every opened workbook name as its 'keys'
Dim key As Variant
' Dim dec As String '<--| do you actually need it?
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Trains") '<-- reference your working worksheet
' dec = .Range("L1") '<-- what's this for? in any case take it out of for loops since its value doesn't depend on current loop variables
For Each objCell In .Range("L3:L100").SpecialCells(xlCellTypeConstants) '<--| loop through L3:L100 range not blank cells only
If TrySetWorksheet(objCell.Value, "Trains", SH) Then '<--|Try to set the wanted worksheet in the wanted workbook: if successful it'd retrun 'True' and leave you with 'SH' variable set to the wanted worksheet
shtDict(SH.Parent.Name) = shtDict(SH.Parent.Name) + 1
Set rFndCell = SH.Range("C3:C1100").Find(objCell.Offset(, 2).Value, LookIn:=xlValues, lookAt:=xlWhole) '<--| specify at least 'LookIn' and 'LookAt' parameters
If Not rFndCell Is Nothing Then rFndCell.Offset(, 10).Resize(, 6).Value = objCell.Offset(, 3).Resize(, 6).Value
End If
Next objCell
End With
For Each key In shtDict.Keys '<--|loop through opened workbooks dictionary keys
Workbooks(key).Close True '<--| close workbook whose name corresponds to current dictionary key
Next
Application.ScreenUpdating = True
End Sub
Function TrySetWorksheet(fileName As String, shtname As String, sht As Worksheet) As Boolean
Set sht = Nothing
On Error Resume Next
Set sht = Workbooks(Right(fileName, Len(fileName) - InStrRev(fileName, "\"))).Worksheets(shtname) '<--| try looking for an already open workbook with wanted name and wanted sheet
If sht Is Nothing Then Set sht = Workbooks.Open(fileName:=fileName).Worksheets(shtname) '<--| if not found then try opening the wanted workbook and set the wanted sheet in it
TrySetWorksheet = Not sht Is Nothing '<--| set the return value to the final result of attempts at locating the wanted sheet
End Function

Dynamic reference of Sheets from a cell - VBA

I'm not sure if this is possible, but it's the one thing I haven't found answered accross the web.
I created one template workbook Schedule.xls that will be filled out by different people, say personA, personB and personC. I need to extract the same range from each workbook by copying it and pasting it into a master file Master.xls, so that I can get the information from each person into this masterbook.
This Master.xls will have as much sheets as persons filling Schedule.xls.
For example, let's stay with those 3 persons: personA, personB and personC.
Once they generate their schedule, I want to get that information and copy it into Master.xls, but in separate sheets named personA, personB and personC.
I want to do this by setting a cell in Schedule.xls, say A1, where people can choose a value between personA, personB and personC.
This way I can create a dynamic reference for the sheet in Master.xls. in which the macro will paste the info.
`Range("B2.D5").Select
Selection.Copy
Workbooks.Open Filename:= _
"C:\My Documents\Master.xlsx"
Sheets(*REFERENCE*).Select
Range("B2").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close`
What should I write instead of REFERENCE to set the sheet I want to write on?
Thanks in advance.
I'll suggest a simple, no-code approach. Then, I'll give you some VBA code for your specific request.
Place two workbooks, Carl's SlaveWB.xlsx and your Master.slxm, in the same folder for simplicity. Open the worksheet you want to sync (1-way copy) in both spreadsheets. Create these sheets manually for this simple example. Now, click in cell A1 in the master sheet. While in edit mode, type "=" then click in cell A1 in Carl's worksheet (in the other workbook). Your sheets are now linked. You can do this not just for A1 but the entire worksheet -- just copy/paste cell A1 to the entire worksheet. Now, Carl can take his workboook on the road. Here is how he check's in. He simply copies his latest workbook into your predesignated folder. When you open your master workbook, it will automatically pull in all the data from Carl's "checked-in" workbook.
If you prefer to copy from one workbook to another (to capture formatting), it is not difficult.
First, rename or delete the old "Carl" worksheet in master. Here is code for deleting a worksheet by name. If the name of the sheet in the master is stored in Carl's "Sheet1" worksheet, cell A1, you can pass this as the value of WSName: Workbooks("SlaveWB").Sheets("Sheet1").Cells(1,1).Value.
'DeleteWorksheet(WSName)
Public Function DeleteWorksheet(WSName As String)
'If Not IIf(IsNull(DebugMode), False, DebugMode) Then On Error GoTo FoundError
If Not Range("DebugMode").Value Then On Error Resume Next
Dim WorksheetExists As Boolean
DeleteWorksheet = False
'if no worksheet name provided, abort
If Len(WSName) < 1 Then Exit Function
'if worksheet exists, delete
WorksheetExists = False
On Error Resume Next
WorksheetExists = (Sheets(WSName).Name <> "") 'if worksheet exists, set WorksheetExists = True
On Error GoTo FoundError
If WorksheetExists Then Sheets(WSName).Delete 'if worksheet exists, delete
DeleteWorksheet = True 'function succeeded (deleted worksheet if it existed)
Exit Function
FoundError:
On Error Resume Next
DeleteWorksheet = False
Debug.Print "Error: DeleteWorksheet(" & WSName & ") failed to delete worksheet. "
End Function
Next, copy the revised worksheet from Carl's workbook to the master. The code below copies a worksheet from srcWBName to tgtWBName and names the sheet whatever you like in tgtWBName. I reocmmend you keep the code only only in the master spreadsheet. It is too risky to put the same code in every copy held by every user. And, it will be hard to manage code updates.
Sub CopyWSBetweenWBs(srcWBName As String, srcWSName As String, _
tgtWBName As String, tgtWSName As String)
'srcWBName - name of PersonA's workbook
'srcWSName - name of worksheet to copy from Person A's workbook
'tgtWBName - target workbook, the master
'tgtWSName - what you want to call the worksheet after copying it to the target/master.
' If you want this sheetname to be taken from a cell, just pass the cell
' reference. For example, this can be
' Workbooks(srcWBName).Sheets(srcWSName).Cells(1,1).Value
Dim srcWB As Workbook
Dim srcWS As Worksheet
Dim tgtWB As Workbook
Dim tgtWS As Worksheet
'Create XL objects
Set srcWB = Workbooks(srcWBName)
Set srcWS = srcWB.Worksheets(srcWSName)
Set tgtWB = Workbooks(tgtWBName)
Set tgtWS = tgtWB.Worksheets(tgtWSName)
' Start at the source
srcWB.Activate
srcWS.Activate
' Copy to target workbook
srcWS.Copy Before:=tgtWB.Sheets(1) '<~~ copy to beginning of workbook
' After copying the worksheet, it is active, so you can rename it now.
ActiveSheet.Name = tgtWSName
End Sub
That's it. I hope this helps.

Moving Worksheets to Newly Created & Version Changed Workbook VBA

I am continuing working with data pulled from a mainframe. The data is largely alphanumeric, and is a continuation of building functionality onto past efforts. The loop in which the sheets are moved was created on the basis of the function discussed in this SO article.
I have consulted this SO article and independently tested the general form of such functionality, but such code is failing in this specific case, perhaps due to version issues or the way I am referencing the new workbook.
I have written a subroutine that shifts worksheets from one workbook to another. It is used in conjunction with a public variable tied to a checkbox, and is intended to provide the user with an easy way to port the form data. The public variable is used in a conditional to call the subroutine if the checkmark is in a checked state.
The code is as follows:
Public Sub MoveSheets()
' This macro moves all sheets but those noted within the If statements,(1)
' (1) which are further nested within the For Each loop.
'See http://msdn.microsoft.com/en-us/library/office/ff198017.aspx for save file format types.
'The file format of this excel macro sheet is 52: xlOpenXMLWorkbookMacroEnabled
'The default save type for the use-case is excel 2003 is compatibility mode.
'The macro is to set the current save type to one compatible with 52.
'In this case, 51: xlOpenXMLWorkbook was selected as the selected type.
'Define Excel Format storage variables.
Dim FileFormatSet As Excel.XlFileFormat
Dim OriginalFileFormatSet As Excel.XlFileFormat
Dim TempFileFormatSet As Excel.XlFileFormat
'Define worksheet/workbook variables.
Dim IndividualWorkSheet As Worksheet
Dim NewWorkBook1 As Workbook
'Set variable to store current time.
Dim CurrentTime As Date
'The original file format.
OriginalFileFormatSet = Application.DefaultSaveFormat
'The file format to be used at the end of the procedure after all is said and done.
FileFormatSet = OriginalFileFormatSet
'The currently desired file format.
TempFileFormatSet = xlOpenXMLWorkbook
'The currently desired file format set as the set default.
Application.DefaultSaveFormat = TempFileFormatSet
'Disable application alerts. Comment the line below to display alerts (2)
'(2) in order to help check for errors.
Application.DisplayAlerts = False
'Save new workbook "NewWorkBook" as default file format.
Workbooks.Add.SaveAs Filename:="NewWorkBook", FileFormat:=Application.DefaultSaveFormat
'Set variable to new workbook "NewWorkBook", which is in .xlsx format.
Set NewWorkBook1 = Workbooks("NewWorkBook.xlsx")
'Activate Macro Window.
Windows("ShifterMacro.xlsm").Activate
'For each worksheet, shift it to the workbook "NewWorkBook" if (3)
'(3) it fails outside the criteria set listed below.
For Each IndividualWorkSheet In ThisWorkbook.Worksheets
If IndividualWorkSheet.Name <> "Sheet1" And IndividualWorkSheet.Name <> "Criteria" And _
IndividualWorkSheet.Name <> "TemplateSheet" And IndividualWorkSheet.Name <> "TemplateSheet2" And _
IndividualWorkSheet.Name <> "Instructions" And IndividualWorkSheet.Name <> "Macro1" And _
IndividualWorkSheet.Name <> "DataSheet" Then
'Select each worksheet.
IndividualWorkSheet.Select
'Shift the worksheetover to the new workbook.
'****NOTE: THIS CODE CURRENTLY RESULTS IN A '1004' RUN-TIME ERROR.****
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
End If
Next
'An ugly set of If Then statements to clean the new workbook (4)
'(4) of its previous sheets, assuming entries are to be made.
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet1").Delete
End If
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet2").Delete
End If
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet3").Delete
End If
'********** CODE CHECKED BUT UNTESTED WITHIN THESE BOUNDARIES **********
'Activate the Window for the new workbook if it is inactive.
Windows("NewWorkBook.xlsx").Activate
'If the number of sheets are greater than 1... (5)
If Sheets.Count > 1 Then
'(6) The time value is parsed to remove unusual characters, following (5)
'(6) the logic of this SO article: https://stackoverflow.com/questions/11364007/save-as-failed-excel-vba.
'Formatted current time as per http://www.mrexcel.com/forum/excel-questions/273280-visual-basic-applications-format-now-yyyymmddhhnnss.html
CurrentTime = Format(Now(), "yyyy-mm-dd-hh-nn-ss")
'(5) Then go ahead and save the file with the current date/time information.
NewWorkBook1.SaveAs Filename:="Form_Data_" & Now, FileFormat:=Application.DefaultSaveFormat
End If
'Set SaveChanges = True, as per https://stackoverflow.com/questions/9327613/excel-vba-copy-method-of-worksheet-fails
ActiveWorkbook.Close SaveChanges:=True
'********** END CODE BOUNDARY **********
'Activate the Window for the Macro.
Windows("ShifterMacro.xlsm").Activate
'Activate a specific sheet of the Macro.
ActiveWorkbook.Sheets("Instructions").Activate
'Change Display Alerts back to normal.
Application.DisplayAlerts = True
'Reset the view for the original data sheet.
With Sheets("Sheet1")
'For when this process is repeated.
If .FilterMode Then .ShowAllData
End With
'Return the Default save format to the original file format.
Application.DefaultSaveFormat = FileFormatSet
End Sub
The code fails at line 62, and results in a '1004' Run-Time error:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
The worksheet referenced holds the correct test value of '100-AAA'. The Sheets.Count is equal to 3. The NewWorkBook1 variable holds the value NewWorkBook.xslx. The path of the generated workbook "NewWorkBook.xslx" is the same as the macro workbook. My version of excel is 2007, although the default for my users is 2003, even though they have the capacity and the installation for 2007.
Why is this run-time error with my Move occuring, and how do I correct this error in order to get my worksheets over to the newly generated workbook?
This:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
just specifies to move the sheet within the same workbook (and it will error if NewWorkBook1 has more sheets than its parent workbook)
Maybe try:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets(NewWorkBook1.Sheets.Count)

Copy an entire worksheet to a new worksheet in Excel 2010

I have found similar questions that deal with copying an entire worksheet in one workbook and pasting it to another workbook, but I am interested in simply copying an entire worksheet and pasting it to a new worksheet -- in the same workbook.
I'm in the process of converting a 2003 .xls file to 2010 .xlsm and the old method used for copying and pasting between worksheets doesn't paste with the correct row heights. My initial workaround was to loop through each row and grab the row heights from the worksheet I am copying from, then loop through and insert those values for the row heights in the worksheet I am pasting to, but the problem with this approach is that the sheet contains buttons which generate new rows which changes the row numbering and the format of the sheet is such that all rows cannot just be one width.
What I would really like to be able to do is just simply copy the entire worksheet and paste it. Here is the code from the 2003 version:
ThisWorkbook.Worksheets("Master").Cells.Copy
newWorksheet.Paste
I'm surprised that converting to .xlsm is causing this to break now. Any suggestions or ideas would be great.
It is simpler just to run an exact copy like below to put the copy in as the last sheet
Sub Test()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Master")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
End Sub
ThisWorkbook.Worksheets("Master").Sheet1.Cells.Copy _
Destination:=newWorksheet.Cells
The above will copy the cells. If you really want to duplicate the entire sheet, then I'd go with #brettdj's answer.
' Assume that the code name the worksheet is Sheet1
' Copy the sheet using code name and put in the end.
' Note: Using the code name lets the user rename the worksheet without breaking the VBA code
Sheet1.Copy After:=Sheets(Sheets.Count)
' Rename the copied sheet keeping the same name and appending a string " copied"
ActiveSheet.Name = Sheet1.Name & " copied"
I really liked #brettdj's code, but then I found that when I added additional code to edit the copy, it overwrote my original sheet instead. I've tweaked his answer so that further code pointed at ws1 will affect the new sheet rather than the original.
Sub Test()
Dim ws1 as Worksheet
ThisWorkbook.Worksheets("Master").Copy
Set ws1 = ThisWorkbook.Worksheets("Master (2)")
End Sub
'Make the excel file that runs the software the active workbook
ThisWorkbook.Activate
'The first sheet used as a temporary place to hold the data
ThisWorkbook.Worksheets(1).Cells.Copy
'Create a new Excel workbook
Dim NewCaseFile As Workbook
Dim strFileName As String
Set NewCaseFile = Workbooks.Add
With NewCaseFile
Sheets(1).Select
Cells(1, 1).Select
End With
ActiveSheet.Paste
If anyone has, like I do, an Estimating workbook with a default number of visible pricing sheets, a Summary and a larger number of hidden and 'protected' worksheets full of sensitive data but may need to create additional visible worksheets to arrive at a proper price, I have variant of the above responses that creates the said visible worksheets based on a protected hidden "Master". I have used the code provided by #/jean-fran%c3%a7ois-corbett and #thanos-a in combination with simple VBA as shown below.
Sub sbInsertWorksheetAfter()
'This adds a new visible worksheet after the last visible worksheet
ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
'This copies the content of the HIDDEN "Master" worksheet to the new VISIBLE ActiveSheet just created
ThisWorkbook.Sheets("Master").Cells.Copy _
Destination:=ActiveSheet.Cells
'This gives the the new ActiveSheet a default name
With ActiveSheet
.Name = Sheet12.Name & " copied"
End With
'This changes the name of the ActiveSheet to the user's preference
Dim sheetname As String
With ActiveSheet
sheetname = InputBox("Enter name of this Worksheet")
.Name = sheetname
End With
End Sub