Help with Delete if exists and copy tab

[richardcdahlgren]

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.

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

 

[ExcelGzh]

richardcdahlgren

If you insert these lines before your sheet Add line

On Error Resume Next
.Sheets(report.ActiveSheet.Range("V1").Value).Delete
On Error GoTo 0

the sheet will be deleted if it already exists. You can then go through the create, copy, rename etc process without error

 

[richardcdahlgren]

Worked perfectly. Thank you!

 

[ExcelGzh]

Glad I could help.