VBA - save as .csv and .text under one button

[STEEL010]

Hi There,

I have a problem that I can't figure out.
I have two sub's that needs to run under one button, and the thing is that it have to create sperate type of file to export (.csv and .txt)
normally they work, but when the CSV file needs that save then it will not?
Can someone help me on this matter.

see below code for impression:



Sub SHEET1_SAVE_AS()
'
If ActiveSheet.Name = "SHEET1" Then
Sheets("SHEET1").Select
Sheets("SHEET1").Range("A2:E50").Select
ActiveWindow.SmallScroll Down:=-27
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SHEET1").Range("A1:F1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("SHEET1").Range("C1:E50").Select
Selection.Delete Shift:=xlToLeft
Sheets("SHEET1").Range("A1").Select

ChDir "\\FILEPATH"
ActiveWorkbook.SaveAs Filename:= _
"\\FILEPATH\" & Format(Now(), "yyyy-mm-dd") & " " & "SHEET1.csv", _
FileFormat:=xlCSV, CreateBackup:=False

Else
End If
End Sub



Sub SHEET2_SAVE_AS()
'
If ActiveSheet.Name = "SHEET2" Then
Sheets("SHEET2").Select
Sheets("SHEET2").Rows("2:2").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Sheets("SHEET2").Rows("2:3").Select
Selection.ClearContents
Sheets("SHEET2").Rows("2:3").Select
Sheets("SHEET2").Rows("2:3").EntireRow.AutoFit
Sheets("SHEET2").Range("A4:F54").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-9
Sheets("SHEET2").Range("A1").Select
Application.CutCopyMode = False

ChDir "\\FILEPATH"
ActiveWorkbook.SaveAs Filename:= _
"\\FILEPATH\" & Format(Now(), "yyyy-mm-dd") & " " & "SHEET2.txt", _
FileFormat:=xlText, CreateBackup:=False

Else
End If
End Sub

 

[DanteAmor]

Each sheet must be validated, for example:

Sub Sheet1_and_Sheet2_Save_AS()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    Set l1 = ThisWorkbook
    s1 = False
    s2 = False
    For Each s In Sheets
        If UCase(s.Name) = UCase("SHEET1") Then
            s1 = True
        End If
        If UCase(s.Name) = UCase("SHEET2") Then
            s2 = True
        End If
    Next
    'Save Sheet1
    If s1 Then
        Sheets("SHEET1").Copy
        Set l2 = ActiveWorkbook
        Set h2 = l2.Sheets(1)
        h2.Range("A2:E50").Copy
        h2.Range("A2").PasteSpecial Paste:=xlPasteValues
        h2.Range("A1:F1").Delete Shift:=xlUp
        h2.Range("C1:E50").Delete Shift:=xlToLeft
        '
        ChDir "\\FILEPATH"
        l2.SaveAs Filename:= _
            "\\FILEPATH\" & Format(Now(), "yyyy-mm-dd") & " " & "SHEET1.csv", _
            FileFormat:=xlCSV, CreateBackup:=False
        l2.Close False
    End If
    '
    'Save Sheet2
    If s2 Then
        wvisible = Sheets("SHEET2").Visible
        If wvisible <> -1 Then
            Sheets("SHEET2").Visible = -1
        End If
        Sheets("SHEET2").Copy
        Set l2 = ActiveWorkbook
        Set h2 = l2.Sheets(1)
        h2.Rows("2:3").Insert Shift:=xlDown
        h2.Rows("2:3").ClearContents
        h2.Rows("2:3").EntireRow.AutoFit
        h2.Range("A4:F54").Copy
        h2.Range("A4").PasteSpecial Paste:=xlPasteValues
        '
        ChDir "\\FILEPATH"
        l2.SaveAs Filename:= _
            "\\FILEPATH\" & Format(Now(), "yyyy-mm-dd") & " " & "SHEET2.txt", _
            FileFormat:=xlText, CreateBackup:=False
        l2.Close False
        Sheets("SHEET2").Visible = wvisible
    End If
    '
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

if sheet1 does not exist and sheet2 does not exist, then which sheet should be saved? the sheet3?

 

[STEEL010]

Hi Dante,

then it must stop, because there is no sheet to save for this particular macro

 

[DanteAmor]

Then do not worry, if the sheets do not exist the macro does not work.

 

[STEEL010]

again your are awesome it works, you saved me a lot headaches....... MUCHAS GRACIAS Y UN GRAN ABRAZO

Each sheet must be validated, for example:

Sub Sheet1_and_Sheet2_Save_AS()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    Set l1 = ThisWorkbook
    s1 = False
    s2 = False
    For Each s In Sheets
        If UCase(s.Name) = UCase("SHEET1") Then
            s1 = True
        End If
        If UCase(s.Name) = UCase("SHEET2") Then
            s2 = True
        End If
    Next
    'Save Sheet1
    If s1 Then
        Sheets("SHEET1").Copy
        Set l2 = ActiveWorkbook
        Set h2 = l2.Sheets(1)
        h2.Range("A2:E50").Copy
        h2.Range("A2").PasteSpecial Paste:=xlPasteValues
        h2.Range("A1:F1").Delete Shift:=xlUp
        h2.Range("C1:E50").Delete Shift:=xlToLeft
        '
        ChDir "\\FILEPATH"
        l2.SaveAs Filename:= _
            "\\FILEPATH\" & Format(Now(), "yyyy-mm-dd") & " " & "SHEET1.csv", _
            FileFormat:=xlCSV, CreateBackup:=False
        l2.Close False
    End If
    '
    'Save Sheet2
    If s2 Then
        wvisible = Sheets("SHEET2").Visible
        If wvisible <> -1 Then
            Sheets("SHEET2").Visible = -1
        End If
        Sheets("SHEET2").Copy
        Set l2 = ActiveWorkbook
        Set h2 = l2.Sheets(1)
        h2.Rows("2:3").Insert Shift:=xlDown
        h2.Rows("2:3").ClearContents
        h2.Rows("2:3").EntireRow.AutoFit
        h2.Range("A4:F54").Copy
        h2.Range("A4").PasteSpecial Paste:=xlPasteValues
        '
        ChDir "\\FILEPATH"
        l2.SaveAs Filename:= _
            "\\FILEPATH\" & Format(Now(), "yyyy-mm-dd") & " " & "SHEET2.txt", _
            FileFormat:=xlText, CreateBackup:=False
        l2.Close False
        Sheets("SHEET2").Visible = wvisible
    End If
    '
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

if sheet1 does not exist and sheet2 does not exist, then which sheet should be saved? the sheet3?

 

[DanteAmor]

Con mucho gusto!