Macro to extract varied data on selected worksheets then save as a CSV

[hajduk1908]

Hello

I need to produce a macro that runs on a workbook with mutiple workssheets and delete a number of rows then extract as csv to the local computer, some of worksheets need the top 10 rows deleted then extracted, others required the top twenty rows deleted before its extracted as a csv. The purpose is to import these csv to another application.

For eg.
If the user selects monday worksheet it deletes the top 11 rows then extracts the remaining rows as a csv to the users local computer.
If the user select tuesday worksheets it deletes the top 15 rows then extracts the remaining data as a csv to the users local computer
If the user selects Wednesday it deletes the top 5 rows in the ws..... so on and so forth

I have a menu which lists all the worksheets in the index, ideally when the user selects a worksheets it would run the macro then delete the numbers of rows required in the worksheet then extract it as a csv

Thanks from newbie
Tom

 

[vletm]

Missing sample file, missing a menu and so on, so test this idea.
It'll ask number of deleting rows from activesheet and
after that, it'll save the activesheet as CVS.
Remember to do backup...

Sub Del_And_CVS()
    Application.ScreenUpdating = False
    a_tab = ActiveSheet.Name
    Do
        del_rows = InputBox("Give Number of Deleting Rows: ", "Number of deleting rows", 1)
        If del_rows <> "" Then
            On Error Resume Next
                chk_del_rows = WorksheetFunction.IsNumber(del_rows)
            If Err.Number <> 0 Then
                del_rows = ""
            Else
                del_rows = Abs(Int(del_rows))
            End If
        End If
    Loop Until del_rows = "" Or WorksheetFunction.IsNumber(del_rows)
    If del_rows = "" Then Exit Sub
    Sheets(a_tab).Rows("1:" & del_rows).Delete
    FS = "\"
    AOS = Application.OperatingSystem
    If Mid(AOS, 1, 3) = "Mac" Then FS = ":"
    filename = ThisWorkbook.Path & FS & a_tab & ".cvs"
    y_max = Worksheets(a_tab).Range("A1").CurrentRegion.Rows.Count
    x_max = Worksheets(a_tab).Range("A1").CurrentRegion.Columns.Count
    Open filename For Output As #1
        With ActiveSheet
            For y = 1 To y_max
                For x = 1 To x_max
                    lineText = IIf(x = 1, "", lineText & ",") & .Cells(y, x)
                Next x
                Print #1, lineText
            Next y
        End With
    Close #1
    Application.ScreenUpdating = False
    ans = MsgBox("Ready")
End Sub

 

[hajduk1908]

Thankyou Vletm!!!!!!::))))