richardcdahlgren
Board Regular
- Joined
- Oct 16, 2008
- Messages
- 81
I have the macro below that works GREAT when I click the button the first time. If I have to make a correction and click the button again, the worksheet already exists and I get an error. My problem is mainly in the bold area below. Any help would be greatly appreciated. I need to look for the variable tab name, delete it if it exists, create new tab, paste data, rename tab to variable.
Rich (BB code):
Sub Button3_Click()
Dim filename As String
Dim path As String
Dim report As Workbook
Dim t As Range
Application.ScreenUpdating = False
Dim i As Integer
Range("BA2:BA700").EntireRow.Hidden = False
Selection.AutoFilter Field:=1, Criteria1:="<>"
Range("BA2:BA700").Select
Selection.ColumnWidth = 0
Selection.Columns.AutoFit
Application.ScreenUpdating = True
ActiveSheet.PrintPreview
Worksheets("Daily Schedule").ShowAllData
'Set the Schedule workbook location to the parent folder of the current working directory
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
filename = oFSO.GetFile(ActiveWorkbook.FullName).ParentFolder.ParentFolder.path & "\" & "Daily Pack Schedules" & ".xlsm"
Dim TRWorkbook As Workbook 'Daily Report
Set report = ActiveWorkbook
'Check if Daily Pack Schedule file exists and if not create it
On Error Resume Next
Set TRWorkbook = Workbooks(filename)
On Error GoTo 0
If TRWorkbook Is Nothing Then 'The file isn't open
If Dir(filename) = "" Then 'The file doesn't exist so create it
Application.ScreenUpdating = False
report.Sheets("Daily Schedule").Range("A1:BE700").Copy
Workbooks.Add
ActiveSheet.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
ActiveSheet.Range("A1").PasteSpecial xlPasteFormats
ActiveSheet.Name = Range("V1").Value
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.SaveAs filename
Application.CutCopyMode = False
ActiveWorkbook.Close
Application.ScreenUpdating = True
Exit Sub
Else 'The file exists so open it
Set TRWorkbook = Workbooks.Open(filename)
End If
End If
With TRWorkbook 'The file exists and is open so create the sheet and copy the current Sheet into it
report.Sheets("Daily Schedule").Range("A1:BE700").Copy
.Activate
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = report.ActiveSheet.Range("V1").Value
.ActiveSheet.Range("A1").PasteSpecial xlPasteFormulasAndNumberFormats
.ActiveSheet.Range("A1").PasteSpecial xlPasteFormats
ActiveSheet.Cells.EntireColumn.AutoFit
TRWorkbook.Save
TRWorkbook.Sheets.Item("End").Move After:=Sheets(Sheets.Count)
TRWorkbook.Sheets.Item("PKG Report").Select
TRWorkbook.Save
TRWorkbook.Close
End With
End Sub
Last edited by a moderator: