Hi,
Here you are
Sub Steffen()
Dim newWb As Workbook
Dim oldWb As Workbook
Set oldWb = ThisWorkbook
Open "C:\\Users\Path\" & Sheets(4).Range("C6").Value & ".txt" For Append As #1
For i = 1 To Sheets(3).UsedRange.Rows.Count
Print #1, Sheets(3).Cells(i, 1).Value
Next i
Close #1
Sheets(2).Range("A:K").Copy
Application.DisplayAlerts = False
Set newWb = Workbooks.Add
With newWb
.Sheets(1).Range("A1").PasteSpecial xlPasteAll
.Sheets(1).UsedRange.RowHeight = 12.75
With.Sheets(1).PageSetup
.PrintArea = oldWb.Sheets(3).PageSetup.PrintArea
.Orientation = xlLandscape
.PrintGridlines = True
End with
.SaveAs "C:\Users\Path\" & oldWb.Sheets(4).Range("C8").Value & ".xlsx", FileFormat:=51
.Close
End With
On Error GoTo err
err:
Application.DisplayAlerts = True
End Sub
Another time it would be best if you described your full question/outcome in your first post as this way off adding questions along the way makes for alot of rewriting.
Steffen Thomsen
Bookmarks