Question

例如，工作簿中有6张。这些表被命名为“第1节”，“第2节”，“第3节”，“第4节”，“第5节”和“第6节”。将这6张纸保存为名为“第1节”，“第2节”，“第3节”，“第4节”，“第5节”和“第6节”的相应文件夹中的单独文件。换句话说，如何将一系列工作表作为单独的文件保存到文件夹数组中。

我试过了：

Select Case x
        Case x = 1
        sec1fol = "\Section 1 Jobs Released Last Week (excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec1fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 2
        sec2fol = "\Section 2 Jobs Created Last Week (excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec2fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 3
        sec3fol = "\Section 3 Late Jobs"
            ActiveWorkbook.SaveAs Filename:=fName & sec3fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 4
        sec4fol = "Section 4 Unnegotiated Jobs"
            ActiveWorkbook.SaveAs Filename:=fName & sec4fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 5
        sec5fol = "\Section 5 Jobs To Go (Excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec5fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
  End Select

和

With Sheets(1)
 sec1fol = "Section 1 Jobs Released Last Week (excludes NRT Jobs)"
    ActiveWorkbook.SaveAs Filename:=fName & sec1fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

With Sheets(2)
 sec2fol = "Section 2 Jobs Created Last Week (excludes NRT Jobs)"
    ActiveWorkbook.SaveAs Filename:=fName & sec2fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

With Sheets(3)
 sec3fol = "Section 3 Late Jobs"
    ActiveWorkbook.SaveAs Filename:=fName & sec3fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

With Sheets(4)
 sec4fol = "Section 4 Unnegotiated Jobs"
    ActiveWorkbook.SaveAs Filename:=fName & sec4fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

With Sheets(5)
 sec5fol = "Section 5 Jobs To Go (Excludes NRT Jobs)"
    ActiveWorkbook.SaveAs Filename:=fName & sec5fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

With Sheets(6)
 sec6fol = "Section 6 Jobs To Go (NRT Jobs)"
    ActiveWorkbook.SaveAs Filename:=fName & sec6fol & "_" & DateString & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End With

此代码部分有效，但仅限第一张然后停止。

Sub SaveWS_to_file()

Dim x As Integer, Name As String, Name2 As String, Name3 As String, fName As String, DateString As String, _
sec1fol As String, sec2fol As String, sec3fol As String, sec4fol As String, sec5fol As String, sec6fol As String

On Error GoTo Error_Handler
For x = 1 To Sheets.Count

Name = "\\MARNV006\BM\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\"
Name = Name & "EDW Crystal Reports (Automation)\Test files\Section "
Name = Name & x & ".xls"
Sheets("Section " & x).Copy
ChDir "\\MARNV006\BM\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\EDW Crystal Reports (Automation)\Test files"

Name2 = "\\insitefs\www\htdocs\c130\comm\metrics\blue\deck_reports\"
Name2 = Name2 & "Section " & x & ".xls"
Sheets("Section " & x).Copy
ChDir "\\insitefs\www\htdocs\c130\comm\metrics\blue\deck_reports\"

fName = "\\marnv006\Bm\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\Blue Deck\Blue Deck "
fName = fName & Year(Date)
DateString = Format(Date, "mm-dd-yyyy")

'Deletes file if it already exists

On Error GoTo Error_Handler

ActiveWorkbook.SaveAs Filename:=Name, _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.SaveAs Filename:=Name2, _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False

With Sheets(x)
Select Case x
        Case x = 1
        sec1fol = "\Section 1 Jobs Released Last Week (excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec1fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 2
        sec2fol = "\Section 2 Jobs Created Last Week (excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec2fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 3
        sec3fol = "\Section 3 Late Jobs"
            ActiveWorkbook.SaveAs Filename:=fName & sec3fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 4
        sec4fol = "Section 4 Unnegotiated Jobs"
            ActiveWorkbook.SaveAs Filename:=fName & sec4fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

        Case x = 5
        sec5fol = "\Section 5 Jobs To Go (Excludes NRT Jobs)"
            ActiveWorkbook.SaveAs Filename:=fName & sec5fol & "_" & DateString & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
  End Select
  End With
'Deletes file if it already exists

On Error GoTo Error_Handler

ActiveWindow.Close
Next x

Exit_Procedure:
Exit Sub

Error_Handler:

    MsgBox "An error has occurred in this application. " _
    & "Please contact your technical support person and " _
    & "tell them this information:" _
    & vbCrLf & vbCrLf & "Error Number " & Err.Number & ", " _
    & Err.Description, _
    Buttons:=vbCritical, Title:="DMT Error"
    Resume Exit_Procedure
    Resume

Error [(errornumber)]
End Sub

Answer 1

你看过：So, I have 6 "master" files to then divide into 40 separate files？我需要完全按照你在问题中描述的那样做。

如何使用VBA，如何将6张Excel工作表保存到6个不同的文件夹中？

1 个答案: