Option Explicit
Sub Create_Quote()
Dim wb As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim MyPath As String
Dim MyFile As String
Dim i As Long
Set wb = ThisWorkbook
Set ws = Sheets("Quote")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
MyFile = ws.Range("E6").Text & " " & ws.Range("F6").Text & " " & ws.Range("B5").Text
Application.SheetsInNewWorkbook = 1
Set wb2 = Workbooks.Add
ws.Copy Before:=wb2.Sheets(1)
With wb2
.Sheets(1).Name = ws.Range("E6").Text & " " & ws.Range("F6").Text
End With
With wb2.Sheets(1).Range("E6:E6")
.Value = .Value
End With
For Each ws2 In wb2.Worksheets
If Not ws2.Name = wb2.Sheets(1).Name Then ws2.Delete
Next ws2
MyPath = "\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
MyPath & Range("E6").Value & Range("F6").Value & Range("A1").Value & Range("B5").Value & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
wb2.Close False
With ws
.Range("B5").MergeArea.ClearContents
.Range("B6").MergeArea.ClearContents
.Range("B7").MergeArea.ClearContents
.Range("B8").MergeArea.ClearContents
.Range("B9").MergeArea.ClearContents
.Range("A12").MergeArea.ClearContents
.Range("C12").MergeArea.ClearContents
.Range("D12").MergeArea.ClearContents
.Range("F12").MergeArea.ClearContents
.Range("B13").MergeArea.ClearContents
For i = 15 To 33
With .Range("A" & i)
.MergeArea.ClearContents
End With
Next i
For i = 15 To 33
With .Range("B" & i)
.MergeArea.ClearContents
End With
Next i
For i = 15 To 33
With .Range("C" & i)
.MergeArea.ClearContents
End With
Next i
For i = 15 To 33
With .Range("D" & i)
.MergeArea.ClearContents
End With
Next i
For i = 15 To 33
With .Range("E" & i)
.MergeArea.ClearContents
End With
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
ws.Range("B1").Value = ws.Range("B1").Value + 1
End Sub
Sub Create_Quote()
Dim wb As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim MyPath As String
Dim MyFile As String
Dim i As Long
Set wb = ThisWorkbook
Set ws = Sheets("Quote")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
MyFile = ws.Range("E6").Text & " " & ws.Range("F6").Text & " " & ws.Range("B5").Text
Application.SheetsInNewWorkbook = 1
Set wb2 = Workbooks.Add
ws.Copy Before:=wb2.Sheets(1)
With wb2
.Sheets(1).Name = ws.Range("E6").Text & " " & ws.Range("F6").Text
End With
With wb2.Sheets(1).Range("E6:E6")
.Value = .Value
End With
For Each ws2 In wb2.Worksheets
If Not ws2.Name = wb2.Sheets(1).Name Then ws2.Delete
Next ws2
MyPath = "\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
MyPath & Range("E6").Value & Range("F6").Value & Range("A1").Value & Range("B5").Value & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
wb2.Close False
With ws
.Range("B5").MergeArea.ClearContents
.Range("B6").MergeArea.ClearContents
.Range("B7").MergeArea.ClearContents
.Range("B8").MergeArea.ClearContents
.Range("B9").MergeArea.ClearContents
.Range("A12").MergeArea.ClearContents
.Range("C12").MergeArea.ClearContents
.Range("D12").MergeArea.ClearContents
.Range("F12").MergeArea.ClearContents
.Range("B13").MergeArea.ClearContents
For i = 15 To 33
With .Range("A" & i)
.MergeArea.ClearContents
End With
Next i
For i = 15 To 33
With .Range("B" & i)
.MergeArea.ClearContents
End With
Next i
For i = 15 To 33
With .Range("C" & i)
.MergeArea.ClearContents
End With
Next i
For i = 15 To 33
With .Range("D" & i)
.MergeArea.ClearContents
End With
Next i
For i = 15 To 33
With .Range("E" & i)
.MergeArea.ClearContents
End With
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
ws.Range("B1").Value = ws.Range("B1").Value + 1
End Sub