I'm trying to set up a spreadsheet that duplicates the previous worksheet into a new tab daily.
I have it set up to create a new worksheet and rename it daily, but I can't figure out the duplication aspect.
Sub AddDayWkst()
Dim ws As Worksheet
Dim strName As String
Dim bCheck As Boolean
On Error Resume Next
strName = Format(Date, "mm-dd-yy")
bCheck = Len(Sheets(strName).Name) > 0
If bCheck = False Then
Set ws = Worksheets.Add(Before:=Sheets(1))
ws.Name = strName
End If
End Sub
I need to duplicate the previous day's worksheet and paste it into the new worksheet.
Sub AddDayWkst()
Dim ws As Worksheet
Dim strNewName As String, strOldName As String
Dim bValid As Boolean
strNewName = Format(Date, "mm-dd-yy")
strOldName = Format(Date - 1, "mm-dd-yy")
bValid = WorksheetExists(strOldName)
If bValid Then
Set ws = Sheets(strOldName)
ws.Copy before:=Worksheets(1)
Worksheets(1).Name = strNewName
End If
End Sub
Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
WorksheetExists = Not sht Is Nothing
End Function
Related
This question already has answers here:
Test or check if sheet exists
(23 answers)
Closed 2 months ago.
I am trying to create multiple worksheet in a workbook and name them based on a contents in a particular table. I am doing this as the list can be dynamic and might need to create more/less sheets depending on the requirement.
Sub CreateSheetsFromList()
Dim NewSheet As Worksheet
Dim x As Integer
Dim tbl As ListObject
Dim cell As Range
Application.ScreenUpdating = False
Set tbl = Worksheets("Sheet1").ListObjects("Table1")
For Each cell In tbl.DataBodyRange.Cells
If SheetExists(cell.Value) = False And cell.Value <> "" Then
Set NewSheet = Sheets.Add(after:=Sheets(Sheets.Count))
NewSheet.Name = cell.Value
End If
Next cell
Application.ScreenUpdating = True
End Sub
Function SheetExists(SheetName As String) As Boolean
Dim sht As Worksheet
On Error Resume Next
Set sht = ActiveWorkbook.Worksheets("Sheet1")
On Error GoTo 0
If Not sht Is Nothing Then SheetExists = True
Set sht = Nothing
End Function
Unable to get any kind of results. Please let me know if there is a way to do this in an optimized manner
You have to use the passed variable to check - not a fixed value ("Sheet1"):
Function SheetExists(SheetName As String) As Boolean
Dim sht As Worksheet
On Error Resume Next
'Use the passed SheetName to test for
Set sht = ActiveWorkbook.Worksheets(SheetName)
On Error GoTo 0
If Not sht Is Nothing Then SheetExists = True
End Function
Add Sheets From Excel Table (ListObject)
Utilization
Sub AddSheetsFromListObjectTEST()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
AddSheetsFromListObject wb, "Sheet1", "Table1", 1
End Sub
The Method
Sub AddSheetsFromListObject( _
ByVal wb As Workbook, _
ByVal WorksheetID As Variant, _
ByVal ListObjectID As Variant, _
ByVal ListColumnID As Variant)
Const PROC_TITLE As String = "Create Sheets From ListObject"
On Error GoTo ClearError
Dim sws As Worksheet: Set sws = wb.Sheets(WorksheetID)
Dim slo As ListObject: Set slo = sws.ListObjects(ListObjectID)
Dim slc As ListColumn: Set slc = slo.ListColumns(ListColumnID)
Dim srg As Range: Set srg = slc.DataBodyRange
Dim dws As Worksheet, sCell As Range, dName As String, NotRenamed As Boolean
For Each sCell In srg.Cells
dName = CStr(sCell.Value)
If dws Is Nothing Then
Set dws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
End If
On Error GoTo RenameError
dws.Name = dName
On Error GoTo ClearError
If NotRenamed Then NotRenamed = False Else Set dws = Nothing
Next sCell
If Not dws Is Nothing Then
Application.DisplayAlerts = False
dws.Delete
Application.DisplayAlerts = True
End If
ProcExit:
Exit Sub
RenameError:
'Debug.Print "Name = """ & dName & """" & vbLf & Left(Err.Description, 48)
NotRenamed = True
Resume Next
ClearError:
MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
& Err.Description, vbCritical, PROC_TITLE
Resume ProcExit
End Sub
Hi I have the following code which loops through dropdown selections and saves each result as a new workbook based on the named range in cell G3. I am trying to edit the code so that it saves all the worksheets to the new file instead of just the active one, if anyone could help? thank you
Sub myFiles()
Dim wb As Workbook
Dim ws As Worksheet
Dim nwb As Workbook
Dim nws As Worksheet
Dim rng As Range
Dim Path As String
Dim myDate As String
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Summary")
Set rng = ws.Range("G3")
Path = "C:\Users\bradley\Desktop\Sales by Month\"
myDate = Format(Now(), "MM-DD-YYYY")
For i = 1 To 4
rng = ws.Range("J" & i)
ws.Copy
Set nwb = ActiveWorkbook
Set nws = nwb.Worksheets("Summary")
With nws
Cells.Copy
Cells.PasteSpecial (xlPasteValues)
End With
Application.DisplayAlerts = False
nwb.SaveAs FileName:=Path & rng & " " & myDate & ".xlsx",
FileFormat:=xlWorkbookDefault
nwb.Close
Application.DisplayAlerts = True
Next i
End Sub
Loop through the sheets but only create a workbook on the first one.
Option Explicit
Sub myFiles()
Const FOLDER = "C:\Users\bradley\Desktop\Sales by Month\"
Dim wb As Workbook, nwb As Workbook
Dim ws As Worksheet, rng As Range
Dim myDate As String, i As Long, j As Long
Dim filename As String
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Summary")
Set rng = ws.Range("G3")
myDate = Format(Now(), "MM-DD-YYYY")
Application.ScreenUpdating = False
For i = 1 To 4
rng.Value2 = ws.Range("J" & i).Value2
' copy all sheets
For j = 1 To wb.Sheets.Count
If j = 1 Then
wb.Sheets(j).Copy
Set nwb = ActiveWorkbook
Else
wb.Sheets(j).Copy after:=nwb.Sheets(j - 1)
End If
With nwb.Sheets(j)
.UsedRange.Value2 = .UsedRange.Value2
End With
Next
' save workbook
filename = FOLDER & rng.Value2 & " " & myDate & ".xlsx"
Application.DisplayAlerts = False
nwb.SaveAs filename:=filename, FileFormat:=xlWorkbookDefault
nwb.Close
Application.DisplayAlerts = True
Next i
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
I'm trying to loop through files in a folder with following path "C:\Users\Ouen\Downloads\Test" and paste each output into a new specific sheet in a MASTER workbook.
For example, the below are all the same worksbooks that each have a specific worksheet called "Annual" with different outputs:
Asset1
Asset2
Asset3
Etc
I would like to copy the whole Annual worksheet from each of the workbooks above and paste into a MASTER workbook, while being able to rename them to the following:
Asset1 - Annual
Asset2 - Annual
Asset3 - Annual
Etc
I have had some luck in copying and pasting from each workbook into the master but I'm unable to to paste each output into a new worksheet within the master and rename. Any ideas?
Sub Assets2Master()
Dim xRg As Range
Dim xSelItem As Variant
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook As Workbook
Dim xSheet As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
xSheetName = "Annual"
xRgStr = "B1:GI100"
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
With xFileDlg
If .Show = -1 Then
xSelItem = .SelectedItems.Item(1)
Set xWorkBook = ThisWorkbook
Set xSheet = xWorkBook.Sheets("MASTER")
If xSheet Is Nothing Then
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "MASTER"
Set xSheet = xWorkBook.Sheets("MASTER")
End If
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
If xFileName = "" Then Exit Sub
Do Until xFileName = ""
Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xFileName = Dir()
xBook.Close
Loop
End If
End With
et xRg = xSheet.UsedRange
xRg.ClearFormats
xRg.UseStandardHeight = True
xRg.UseStandardWidth = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Copy to the end
This code will copy, if it exists, the Annual worksheet from each workbook in the folder you select via the dialog.
They will be copied to the workbook the code is in and the copied sheets will be renamed with the name of the workbook they came from appended with - Annual.
The copied sheets will be copied after the last sheet in the MASTER workbook.
Sub Assets2Master()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim dlg As Object
Dim strFileName As String
Dim strFolder As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
With dlg
If .Show = -1 Then
strFolder = .SelectedItems.Item(1)
End If
End With
Set wbDst = ThisWorkbook
strFileName = Dir(strFolder & "\*.xlsx", vbNormal)
If strFileName = "" Then Exit Sub
Do Until strFileName = ""
If strFileName <> wbDst.Name Then
Set wbSrc = Workbooks.Open(strFolder & "\" & strFileName)
' check if 'Annual' sheet exists, and if it does copy it to master workbook
If IfSheetExists("Annual", wbSrc) Then
Set wsSrc = wbSrc.Sheets("Annual")
With wbDst
wsSrc.Copy After:=.Sheets(.Sheets.Count)
.Sheets(.Sheets.Count).Name = Left(strFileName, Len(strFileName) - 5) & " - Annual"
End With
End If
wbSrc.Close SaveChanges:=False
End If
strFileName = Dir()
Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function IfSheetExists(strName As String, Optional wb As Workbook) As Boolean
' checks for the existence of a worksheet named strName in the, optional, workbook wb
' if wb not stated checks in the active workbook
Dim ws As Worksheet
If wb Is Nothing Then
Set wb = ActiveWorkbook
End If
For Each ws In wb.Sheets
If ws.Name = strName Then
IfSheetExists = True
Exit For
End If
Next ws
End Function
Copy after specific sheet
This code is basically identical to the previous code but the workheets will be copied after a specific worksheet in the MASTER workbook.
Option Explicit
Sub Assets2Master()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim dlg As Object
Dim strFileName As String
Dim strFolder As String
Dim lngDstIndex As Long
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
With dlg
If .Show = -1 Then
strFolder = .SelectedItems.Item(1)
End If
End With
Set wbDst = ThisWorkbook
' change Specific Tab to the name ypu want the sheets to be copied after
lngDstIndex = wbDst.Sheets("Specific Tab").Index
strFileName = Dir(strFolder & "\*.xlsx", vbNormal)
If strFileName = "" Then Exit Sub
Do Until strFileName = ""
If strFileName <> wbDst.Name Then
Set wbSrc = Workbooks.Open(strFolder & "\" & strFileName)
' check if 'Annual' sheet exists, and if it does copy it to master workbook
If IfSheetExists("Annual", wbSrc) Then
Set wsSrc = wbSrc.Sheets("Annual")
With wbDst
' copy sheet to MASTER workbook
wsSrc.Copy After:=.Sheets(.Sheets.Count)
' rename sheet and move it after specified sheet
With .Sheets(.Sheets.Count)
.Name = Left(strFileName, Len(strFileName) - 5) & " - Annual"
.Move After:=wbDst.Sheets(lngDstIndex)
lngDstIndex = lngDstIndex + 1
End With
End With
End If
wbSrc.Close SaveChanges:=False
End If
strFileName = Dir()
Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function IfSheetExists(strName As String, Optional wb As Workbook) As Boolean
' checks for the existence of a worksheet named strName in the, optional, workbook wb
' if wb not stated checks in the active workbook
Dim ws As Worksheet
If wb Is Nothing Then
Set wb = ActiveWorkbook
End If
For Each ws In wb.Sheets
If ws.Name = strName Then
IfSheetExists = True
Exit For
End If
Next ws
End Function
Try this. The Master wb should be placed in a different folder than the one you store the Asset Files:
Sub Assets2Master()
Dim xRg As Range
Dim xSelItem As Variant
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook As Workbook
Dim xSheet As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
xSheetName = "Annual"
xRgStr = "B1:GI100"
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
With xFileDlg
If .Show = -1 Then
xSelItem = .SelectedItems.item(1)
Set xWorkBook = ActiveWorkbook
Set xSheet = xWorkBook.Sheets("MASTER")
If xSheet Is Nothing Then
xWorkBook.Sheets.Add(After:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = "MASTER"
Set xSheet = xWorkBook.Sheets("MASTER")
End If
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
If xFileName = "" Then Exit Sub
Do Until xFileName = ""
Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xFileName = Dir()
xBook.Close
xBook.Name = xBook.Name & " - Annual"
Loop
End If
End With
Set xRg = xSheet.UsedRange
xRg.ClearFormats
xRg.UseStandardHeight = True
xRg.UseStandardWidth = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Stack Ranges
This is about what I thought your code was supposed to do. What you asked for is kind of illustrated with the commented block of code in the Do...Loop. By modifying the code in the Do...Loop, there are many possibilities of what you could achieve.
Option Explicit
Sub StackRanges()
' Source
Const sName As String = "Sheet1" ' "Annual"
Const sAddress As String = "B1:GI100"
' Destination
Const dName As String = "MASTER"
Const dCol As String = "A"
Application.ScreenUpdating = False
' Open the dialog to pick a folder.
Dim xFileDlg As FileDialog
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Dim sFolderPath As Variant
With xFileDlg
.InitialFileName = ThisWorkbook.Path
If .Show = True Then
sFolderPath = .SelectedItems.Item(1)
Else
MsgBox "Canceled.", vbExclamation, "Assets2Master"
Exit Sub
End If
End With
' Write the name of the first file to the Source File Name variable.
Dim sfName As String: sfName = Dir(sFolderPath & "\*.xlsx")
' Validate first Source File Name.
If Len(sfName) = 0 Then Exit Sub ' no files found
' Create a reference to the Destination Workbook.
Dim dwb As Workbook: Set dwb = ThisWorkbook
' Write the name of the Destination Workbook
' to the Destination File Name variable.
Dim dfName As String: dfName = dwb.Name
' Attempt to create a reference to the Destination Worksheet.
Dim dws As Worksheet
On Error Resume Next
Set dws = dwb.Worksheets(dName)
On Error GoTo 0
' If the attempt was unsuccessful, add a new worksheet and do it now.
If dws Is Nothing Then
dwb.Worksheets.Add(After:=dwb.Sheets(dwb.Sheets.Count)).Name = dName
Set dws = dwb.Worksheets(dName)
' Maybe add some headers... to the Destination Worksheet.
End If
' Create a reference to the (first) Destination Range.
Dim drg As Range: Set drg = dws.Range(sAddress)
Dim rCount As Long: rCount = drg.Rows.Count
Dim cCount As Long: cCount = drg.Columns.Count
Set drg = dws.Cells(dws.Rows.Count, dCol).End(xlUp) _
.Offset(1, 0).Resize(rCount, cCount)
' Declare additional variables for the following 'Do Loop'.
Dim swb As Workbook
Dim sws As Worksheet
Dim srg As Range
' Loop through the files in the folder...
Do Until Len(sfName) = 0
' Check if the Source File Name is different
' than the Destination File Name.
If StrComp(sfName, dfName, vbTextCompare) <> 0 Then
' Open and create a reference to the Source Workbook.
Set swb = Workbooks.Open(sFolderPath & "\" & sfName)
' Attempt to create a reference to the Source Worksheet.
Set sws = Nothing
On Error Resume Next
Set sws = swb.Worksheets(sName)
On Error GoTo 0
' Stack Ranges
' If the attempt was successful...
If Not sws Is Nothing Then
' Create a reference to the Source Range.
Set srg = sws.Range(sAddress)
' Copy the values from the Source to the Destination Range
' by assignment.
drg.Value = srg.Value
' Create a reference to the (next) Destination Range.
Set drg = drg.Offset(rCount)
End If
' ' Copy Worksheets (instead)
'
' ' If the attempt was successful...
' If Not sws Is Nothing Then
' sws.Copy After:=dwb.Sheets(dwb.Sheets.Count)
' ' Caution: Has to be less than 32 characters!
' ActiveSheet.Name = Left(sfName, Len(sfName) - 5) & " - " & sName
' End If
' Close the Source Workbook.
swb.Close SaveChanges:=False
End If
' Write the name of the next file to the Source File Name variable.
sfName = Dir
Loop
Application.ScreenUpdating = True
' Inform the user.
MsgBox "Data copied.", vbInformation, "Assets2Master"
End Sub
I am Trying to run this Code, which will copy the Source sheet Row to Destination Sheet last Row, but my this code giving error 400 while compiling,
Advance Thanks for Help
Sub CopyData()
Dim sBook_t As String
Dim sBook_s As String
Dim sSheet_t As String
Dim sSheet_s As String
On Error GoTo Errorcatch
sBook_t = "C:\Users\Unknown\Desktop\Free\Calculators.xlsx"
Workbooks.Open (sBook_t)
sBook_s = "C:\Users\Unknown\Desktop\Free\PRODUCT_35.xlsm"
Workbooks.Open (sBook_s)
sSheet_t = "cstdatalist"
sSheet_s = "cstdata"
Sheets(sSheet_s).Range("A2").Copy Destination:=Sheets(sSheet_t).Range("A2")
End Sub
Have a try on following sub.
Sub CopyData()
Dim wb As Workbook
Dim sht, shtLocal As Worksheet
Dim rngPaste As Range
Dim rngLastData, wbPath As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
wbPath = "D:\dBook.xlsx"
Set wb = Workbooks.Open(wbPath)
Set sht = wb.Sheets(1)
Set shtLocal = ThisWorkbook.Sheets("Sheet1")
Set rngPaste = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1) 'Destination range set after last used cell of column A
rngLastData = shtLocal.Cells(Rows.Count, "A").End(xlUp).Address
shtLocal.Range("A1:" & rngLastData).Copy rngPaste
wb.Save
wb.Close
Set sht = Nothing
Set shtLocal = Nothing
Set rngPaste = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
enter code hereHere is my adjustment of your code. What I did is declared the workbooks and the worksheets separately. This way it is clear which workbook/sheet is the source and which is the destination.
Sub CopyData()
Dim sBook_t As String
Dim sBook_s As String
Dim workbook_t As Workbook
Dim sSheet_t As Worksheet
Dim sSheet_s As Worksheet
Dim sSheet_t As String
Dim sSheet_s As String
On Error GoTo Errorcatch
sBook_t = "C:\Users\Unknown\Desktop\Free\Calculators.xlsx"
set workbook_t = Workbooks.Open (sBook_t)
sBook_s = "C:\Users\Unknown\Desktop\Free\PRODUCT_35.xlsm"
set workbook_s = Workbooks.Open (sBook_s)
set sSheet_t = workbook_t.Sheets("cstdatalist")
set sSheet_s = workbook_s.Sheets("cstdata")
sSheet_s.Range("A2").Copy Destination:=sSheet_t.Range("A2")
End Sub
My macro is going through a folder and picking each Excel file and deleting the first tab which is named some_Accounts and then copy pasting data to the master workbook where the worksheet names match.
Getting the following error Method 'Name' of object '_Worksheet' on the following line of code
Set wsDst = wbDst.Worksheets(wsSrc.Name)
I made sure that the worksheet names are equal.
Sub ProjectMacro()
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim lLastRow As Long
Dim LC As Long
Dim s As Worksheet, t As String
Dim i As Long, K As Long
K = Sheets.Count
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Set wbDst = ThisWorkbook
MyPath = "C:\Users\Adam\Desktop\some files\"
strFilename = Dir(MyPath & "*.xls*", vbNormal)
Do While strFilename <> ""
Set wbSrc = Workbooks.Open(MyPath & strFilename)
'loop through each worksheet in the source file
For Each wsSrc In wbSrc.Worksheets
'Find the corresponding worksheet in the destination with the same
name as the source
For i = K To 1 Step -1
t = Sheets(i).Name
If t = "some_Accounts" Then
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
End If
Next i
Set wsDst = wbDst.Worksheets(wsSrc.Name)
On Error GoTo 0
If wsDst.Name = wsSrc.Name Then
lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1
wsSrc.UsedRange.Copy
wsDst.Range("A" & lLastRow).PasteSpecial xlPasteValues
End If
Next wsSrc
wbSrc.Close False
strFilename = Dir()
Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Right now, you are looping through all the Worksheets in wbSrc. When wsSrc is the "some_Accounts" sheet, right after you've deleted it within For i = K to 1... End For, it no longer exists, and thus wsSrc has no Name and will throw an error later on. If you're deleting a sheet, do so before you loop through all the sheets in a workbook.
But since you are closing wbSrc without saving changes, I assume that you don't really need to delete that sheet; you can just skip it as you're looping.
That would look something like this:
For Each wsSrc In wbSrc.Worksheets
If wsSrc.Name <> "some_Accounts" Then
'... copy and pasting code here
End If
Next wsSrc
Note that you can incorporate a WorksheetExists function into your code to make sure that there is a matching sheet in wbDst. That's already been provided in another answer.
Try to put this in your code to see if the worksheet exists:
If worksheetExists(wbDst, wsDst.Name) = true then
MsgBox "Exists!"
else
MsgBox "Does not exist!"
end if
Public Function worksheetExists(ByVal wb As Workbook, ByVal sheetNameStr As String) As Boolean
On Error Resume Next
worksheetExists = (wb.Worksheets(sheetNameStr).Name <> "")
Err.Clear: On Error GoTo 0
End Function