使用 vba 代码按工作表名称更改和定义代码

Change and define code by sheets names with vba code

目前我有以下代码:

 Sub EXCELS()

'Create excel files

 Dim i As Integer
 Dim name_file As String
 For i = 5 To Sheets.Count
 name_file = Sheets(i).Name

 Worksheets(i).Copy

 With ActiveWorkbook
 .SaveAs Filename:="C:\Users\marya\OneDrive - Desktop\Cantina\listas" & "\" & 
 name_file & ".xlsx", FileFormat:=xlOpenXMLWorkbook
 .Close SaveChanges:=False
 End With
 Next i

 End Sub

我想用 sheet 的名字更改和定义下面的代码,如“Lista_AA”、“Lista_BB”。不是从 sheet 5 创建 excel 文件,而是创建包含名称“Lista_AA”、“Lista_BB”...[=14= 的 excel 文件]

For i = 5 To Sheets.Count

错误:

不清楚我们如何知道哪些 sheet 应该导出到他们自己的工作簿中。此答案假定您要导出名称以“Lista_”开头的每个 sheet,以便导出“Lista_AA”、“Lista_BB”而不是“[=17=” ]

Sub EXCELS()
    'Create excel files
    
    Dim i As Integer
    Dim name_file As String
    
    For i = 1 To Worksheets.Count
        name_file = Sheets(i).Name
        If Left(name_file, 6) = "Lista_" Then
            Worksheets(i).Copy
            
            With ActiveWorkbook
                .SaveAs Filename:="C:\Users\marya\OneDrive - Desktop\Cantina\listas\" & _
                name_file & ".xlsx", FileFormat:=xlOpenXMLWorkbook
                .Close SaveChanges:=False
            End With
        End If
    Next i

End Sub

如果 sheet 名称有不同的模式,或者如果您想指定要导出的 sheet 名称列表,请在下面发表评论,我会修改或制作一个新的答案。

这个版本会在不提示用户的情况下覆盖现有的同名工作簿

Sub EXCELS()
    'Create excel files
    
    Dim i As Integer
    Dim name_file As String
    Dim file_path as String

    Application.DisplayAlerts = False

    For i = 1 To Worksheets.Count
        name_file = Sheets(i).Name
        If Left(name_file, 6) = "Lista_" Then
            Worksheets(i).Copy
            file_path = "C:\Users\marya\OneDrive - Desktop\Cantina\listas\" & name_file & ".xlsx"

            ' try to delete a file that has the same name as the one we are about to save  
            on error resume next
            kill file_path
            on error goto 0     

            debug.print file_path
            With ActiveWorkbook
                .SaveAs Filename:=file_path, FileFormat:=xlOpenXMLWorkbook
                .Close SaveChanges:=False
            End With
        End If
    Next i

End Sub