Вывод нескольких файлов CSV для всех, кроме одного листа в VBA и переименование

Question

У меня есть 4 отдельных рабочих листа - один с названием «Основной», один с «Данные 1», один с «Данные 2» и один с «Данные 3».

У меня есть кнопка наосновной лист, на котором при нажатии все три листа данных преобразуются с использованием одной и той же функции, но я застрял на том, что мне также нужно преобразовать эти 3 листа данных в 3 отдельных файла CSV с именами «output_data1.csv»,«output_data2.csv» и «output_data3.csv», но также для того, чтобы он был достаточно гибким, чтобы работать с другим листом данных 4, если я добавлю его позже.

Есть ли способ, которым я могу это сделать?Главное, на чем я застрял - это возможность переименовать его, но сохранить исходный файл Excel без изменений.

Sub DumpOutput()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Main" Then
        ProcessData ws
    End If
Next ws
End Sub

Sub ProcessData(ByRef w As Worksheet)
Dim N As Long, wf As WorksheetFunction, M As Long
Dim i As Long, J As Long
Dim rng As Range
Dim Temp
Dim nams As Variant
Dim F
Dim Dex As Integer
 N = Columns.Count
 M = Rows.Count
With w
    Set wf = Application.WorksheetFunction

         Application.ScreenUpdating = False

    For i = N To 1 Step -1
           If wf.CountBlank(.Columns(i)) <> M Then Exit For
    Next i

    For J = i To 1 Step -1
        If wf.CountBlank(.Columns(J)) = M Then
            .Cells(1, J).EntireColumn.Delete
        End If
    Next J

    For J = M To 1 Step -1
         If wf.CountBlank(.Rows(J)) <> N Then Exit For
    Next J

        For i = J To 1 Step -1
            If wf.CountBlank(.Rows(i)) = N Then
        .Cells(1, i).EntireRow.Delete
            End If
        Next i

        Application.ScreenUpdating = True

    nams = Array("NAME", "TICKER", "PRICE", "CURRENCY", "ISIN", "TYPE")
    Set rng = .Range("A1").CurrentRegion
    For i = 1 To rng.Columns.Count
        For J = i To rng.Columns.Count
            For F = 0 To UBound(nams)
                If nams(F) = rng(J) Then Dex = F: Exit For
            Next F

        If F < i Then
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        End If
        Next J
    Next i



    .Range("f1:f13") = Application.Transpose(Array("TYPE", "Stock", "Stock", "Stock", "Index", "Stock", "Stock", "Stock", "Index", "Stock", "Stock", "Stock", "Index"))
    w.Cells.EntireColumn.AutoFit
    Debug.Print .Name
End With
End Sub

Answer 1

Учитывая, что вы передаете рабочий лист непосредственно в функцию, вы можете применить небольшое изменение к Sub, чтобы сделать так, как вам требуется, для любого количества и любых рабочих листов, которые вы передаете в него:

Sub ProcessData(ByRef w As Worksheet)
Dim N As Long, wf As WorksheetFunction, M As Long
Dim i As Long, J As Long
Dim rng As Range
Dim Temp
Dim nams As Variant
Dim F
Dim Dex As Integer
 N = Columns.Count
 M = Rows.Count
With w
    Set wf = Application.WorksheetFunction

         Application.ScreenUpdating = False

    For i = N To 1 Step -1
           If wf.CountBlank(.Columns(i)) <> M Then Exit For
    Next i

    For J = i To 1 Step -1
        If wf.CountBlank(.Columns(J)) = M Then
            .Cells(1, J).EntireColumn.Delete
        End If
    Next J

    For J = M To 1 Step -1
         If wf.CountBlank(.Rows(J)) <> N Then Exit For
    Next J

        For i = J To 1 Step -1
            If wf.CountBlank(.Rows(i)) = N Then
        .Cells(1, i).EntireRow.Delete
            End If
        Next i

        Application.ScreenUpdating = True

    nams = Array("NAME", "TICKER", "PRICE", "CURRENCY", "ISIN", "TYPE")
    Set rng = .Range("A1").CurrentRegion
    For i = 1 To rng.Columns.Count
        For J = i To rng.Columns.Count
            For F = 0 To UBound(nams)
                If nams(F) = rng(J) Then Dex = F: Exit For
            Next F

        If F < i Then
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        End If
        Next J
    Next i



    .Range("f1:f13") = Application.Transpose(Array("TYPE", "Stock", "Stock", "Stock", "Index", "Stock", "Stock", "Stock", "Index", "Stock", "Stock", "Stock", "Index"))
    w.Cells.EntireColumn.AutoFit
    Debug.Print .Name
End With

' Now make a copy of the Worksheet to a new workbook
w.Copy
' And save the newly created workbook with that sheet as a csv
ActiveWorkbook.SaveAs Filename:="C:\myPath\" & w.Name & ".csv", _
                  FileFormat:=xlCSV
End Sub