Macros To Save Worksheet as New xlsx file & Save Another Worksheet As A Text File

Assistance appreciated please.

I’m looking for a couple of macros to do the following on a worksheet as per the attached example, ExampleData_04.xlsx:-

Macro 1 – To save the sheet “Data Sheet” as a new xlsx file with values and formatting, and use the name taken from cell C8 on the “Reference “ sheet for the filename. The “Data Sheet” sheet will be of variable length and will include blank rows.

Macro 2 – To save the contents of column A in sheet “Config” down to the last row that is used, into a text file using the name taken from cell C6 on the “Reference” sheet for the filename. The “Config” sheet will be of variable length up to approx 3000 rows and will include blank rows.

I believe that this can be done using shell commands but this is not something that I have experience of. Any help would be greatly appreciated.

Thanks

Keith

Sub Steffen()

Open "C:\\Users\Path\" & Sheets("Config").Range("C6").Value & ".txt" For Append As #1
    For i = i To Sheets("Config").UsedRange.Rows.Count
        Print #1, Cells(i, 1)
    Next i
Close #1

On Error GoTo err
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "C:\Users\Path\" & Sheets("Data Sheet").Range("C8").Value & ".xlsx", FileFormat:=51
err:
Application.DisplayAlerts = True

End Sub

*EDIT reason: Wrong fileformat

Hi,

It needed a bit of alteration as you can se, this should work though

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("A1:K" & Sheets(3).UsedRange.Rows.Count).Copy
Application.DisplayAlerts = False
Set newWb = Workbooks.Add
    With newWb
        .Sheets(1).Range("A1").PasteSpecial xlPasteAll
        .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

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

Hi,

Sub Steffen()

Dim newWb As Workbook
Dim oldWb As Workbook

Set oldWb = ThisWorkbook

Open "C:\Users\Keith\Documents\ATest\" & 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
        .CenterHeader = oldWb.Sheets(4).Range("C3") & "_" & oldWb.Sheets(4).Range("C4")
        .Zoom = 85
        End With
        .SaveAs "C:\Users\keith\Documents\ATest\" & oldWb.Sheets(4).Range("C8").Value & ".xlsx", FileFormat:=51
        .Close
    End With
On Error GoTo err

err:
Application.DisplayAlerts = True

End Sub