Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all articles
Browse latest Browse all 50123

HELP compile error for without next????

$
0
0
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

Viewing all articles
Browse latest Browse all 50123

Trending Articles