Excel VBA Salvare fogli in più cartelle con nomi unici

Grazie per tutto l'input. Il codice riportto di seguito è un culmine dell'input ricevuto. Ho commentato gli errori che riguardano direttamente il risultato complessivo desiderato di salvare nelle cartelle definite nell'arrays.

Option Explicit Public EngName As String, TeamNum As Variant Public x As Integer Option Base 1 '### From David Zemens ### Function secfol(i As Long) secfol = Array("", _ "Section 1 Jobs Released Last Week (excludes NRT Jobs)", _ "Section 2 Jobs Created Last Week (excludes NRT Jobs)", _ "Section 3 Late Jobs", _ "Section 4 Unnegotiated Jobs", _ "Section 5 Jobs To Go (Excludes NRT Jobs)", _ "Section 6 Jobs To Go (NRT Jobs)")(i) End Function Sub ADMS_Processing() Application.ScreenUpdating = False 'Opens files and copies worksheets to one workbook and names each worksheet Dim strFilePath As String Dim Name As String Workbooks.Open Filename:= _ "\\MARNV006\BM\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\EDW Crystal Reports (Automation)\ePortfolio1.xls" Sheets(1).Name = "Section 1" '======================================================================= ' Save file to "Schedule Update Requests" folder & Closes Excel '======================================================================= Name = "\\MARNV006\BM\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\" Name = Name & "EDW Crystal Reports (Automation)\Test files\ADMS Combined File" Name = Name & Format(Date, "_mm-d-yy") & ".xls" 'Deletes file if it already exists On Error Resume Next Kill (Name) ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Name = "ADMS Combined File" & Format(Date, "_mm-d-yy") & ".xls" 'This gets the downloaded reports "ePortfolio" 1-6 and Saves indivdiual files for each Section, Section 1-6, which are the Sheets of the combined file '###The Sections (Sheets) are not currently being saved as individual files. There should be 7 files; one for each sheet and a combined file. 'Opens moves the worksheet and closes files for sections 2 through 6 For x = 2 To 6 strFilePath = "\\MARNV006\BM\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\" strFilePath = strFilePath & "EDW Crystal Reports (Automation)\ePortfolio" strFilePath = strFilePath & x & ".xls" Workbooks.Open Filename:=strFilePath Sheets(1).Copy After:=Workbooks(Name).Sheets(x - 1) ActiveSheet.Name = "Section " & x Workbooks(Right(strFilePath, 15)).Close SaveChanges:=False Next x '###The Combined file is being saved correctly, but the individual sheet files are not currently saving Next x Call ScrubSheets Call SaveWS_to_file End Sub 

Salvataggio dei file

  • Come copiare da Excel e incollare come image in Word utilizzando Python?
  • Confronta due colonne e elenca una terza colonna
  • Qual è la differenza tra il file .xls esportto con tag di visualizzazione e creato con Excel
  • PHPExcel_Style_NumberFormat - 01234 (zero troncato)
  • Excel si blocca quando si chiude, dopo aver eseguito VBA
  • Errore di Excel VLookup #NV
  •  Sub SaveWS_to_file() Dim i As Long, Name1 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 For i = 1 To 6 ' ### OTHER STUFF IN YOUR CODE... from David Zemens Name1 = "\\MARNV006\BM\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\" Name1 = Name1 & "EDW Crystal Reports (Automation)\Test files\Section " Name1 = Name1 & i & ".xls" Sheets("Section " & x).Copy ChDir "\\MARNV006\BM\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\EDW Crystal Reports (Automation)\Test files" 

    '### Questi sono solo salvati per il primo foglio, sezione 1

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

    '### Questo file è attualmente solo salvato nel path della cartella sotto come DateString ### fName = "\ marnv006 \ Bm \ Master Scheduling \ DSC 2.3.4 Metodi di rilascio di lavori di ingegneria \ Blue Deck \ Blue Deck"' ## # Aggiunto il backslash per il test per correggere il path del file ### fName = fName & Year (Date) & "\" '### Questo dovrebbe essere come \ marnv006 # marnv006 \ Bm \ Master Scheduling \ DSC 2.3.4 \ Ponte blu \ ponte blu 2016 \

     'Then the arrays function to get the folder gets the destination folder 'The file path for the first sheet would be like: '"\\marnv006\#marnv006\Bm\Master Scheduling\DSC 2.3.4 Engineering Job Release Metrics\Blue Deck\Blue Deck 2016\_ 'Section 1 Jobs Released Last Week (excludes NRT Jobs)\Section 1_12_19_2016.xls" DateString = Format(Now, "mm_dd_yyyy") 'Deletes file if it already exists On Error Resume Next Kill (Name1) Kill (Name2) 'from David Zemens ' ### Save the sheet at this loop iteration: With Sheets("Section " & i) 

    'Deve salvare each foglio come file separato nella corrispondente cartella dalla function arrays

    '### Qui non viene salvato niente

      .SaveAs Filename:=fName & "\" & secfol(i) & "_" & DateString, _ FileFormat:=.Parent.FileFormat, _ Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False 'Save file in first location ActiveWorkbook.SaveAs Filename:=Name1, _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False 'Save file in second location ActiveWorkbook.SaveAs Filename:=Name2, _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False End With Next i End Sub Sub ScrubSheets() Dim lastRow As Long Dim myRow As Long Dim US As String US = "UTILITIES & SUBSYSTEMS" 'Find last row in column A lastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Loop for all cells in column A from rows 2 to last row For myRow = 2 To lastRow 'First check value of column G If Cells(myRow, "G") = "PROPULSION" Then Cells(myRow, "G") = US Else 'Then check column H If Cells(myRow, "H") = "Q3S2531" Then Cells(myRow, "G") = "FUNCTIONAL TEST" Else ' Check four character prefixes Select Case Left(Cells(myRow, "A"), 4) Case "32EB", "35EB", "32EF", "35EF" Cells(myRow, "G") = "AVIONICS" Case Else 'Check 3 character prefixes Select Case Left(Cells(myRow, "A"), 3) Case "35W" Cells(myRow, "G") = "WIRING" Case "34S" Cells(myRow, "G") = "SOFTWARE" Case Else 'Check 2 character prefixes Select Case Left(Cells(myRow, "A"), 2) Case "10", "11", "12", "13", "14", "15" Cells(myRow, "G") = "AIRFRAME" Case "21", "23" Cells(myRow, "G") = US '"UTLITLIES & SUBSYSTEMS" Case "24", "25" Cells(myRow, "G") = US '"UTLITLIES & SUBSYSTEMS" End Select End Select End Select End If End If Next myRow Application.ScreenUpdating = True End Sub 

  • Excel VBA - Estrai le date corrette da date mal formattate?
  • Excel codice VBA per sostituire tutti "." Per "," in una colonna
  • Excel VBA Modifica numero di formato sulla modifica della cella
  • Usando la function InStr per eliminare solo i valori come da un intervallo
  • Estrai la prima lettera dalla cella concatenata con un'altra cella di cella in terza cella, quindi la fila successiva
  • VBA - Ottenere tutti i routes di file da tutte le sottocartelle nella directory online
  • 2 Solutions collect form web for “Excel VBA Salvare fogli in più cartelle con nomi unici”

    Non sono sicuro di capire completamente quello che stai cercando di realizzare, ma di fare il codice dentro. With lavoro in un ciclo, ecco un suggerimento.

    È ansible inizializzare inizialmente i nomi delle cartelle all'interno di un arrays come questo:

      secfol = Array("", _ "Section 1 Jobs Released Last Week (excludes NRT Jobs)", _ "Section 2 Jobs Created Last Week (excludes NRT Jobs)", _ "Section 3 Late Jobs", _ "Section 4 Unnegotiated Jobs", _ "Section 5 Jobs To Go (Excludes NRT Jobs)", _ "Section 6 Jobs To Go (NRT Jobs)") 

    e quindi fare riferimento al nome della cartella corrispondente come secfol(x) come sotto:

      For i = 1 to 6 Sheets("Section " & x).copy ActiveWorkbook.SaveAs Filename:=fName & secfol(x) & "_" & DateString & ".xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Next i 

    Qui, sovrascrivete l'assegnazione di Name , probabilmente è un errore e dovrebbe essere Name2 :

     '### Initial assignment of Name 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" '### Look closely at the below, you're now overwriting `Name` instead of ' Name2 Name2 = "\\insitefs\www\htdocs\c130\comm\metrics\blue\deck_reports\" Name = Name & "Section " & x & ".xls" Name = Name & x & ".xls" Sheets("Section " & x).Copy ChDir "\\insitefs\www\htdocs\c130\comm\metrics\blue\deck_reports\" 

    Nelle istruzioni SaveAs , probabilmente hai bisogno di un separatore di path tra il nome di fName e il nome di sezione.

     `.SaveAs Filename:=fName & "\" & sec1fol & ... 

    Penso che sia anche ansible ignorare l'estensione di questa string in quanto salverà il tipo di file corretto in base al parametro specificato per FileFormat argomento FileFormat :

     ActiveWorkbook.SaveAs _ Filename:=fName & "\" & sec1fol & "_" & DateString, _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False 

    Problemi aggiuntivi (potenziali):

    1. Stai creando 2 copie di Sheets(x) senza una destinazione. Questo crea immediatamente il foglio copiato come una nuova cartella di lavoro, che diventa quindi ActiveWorkbook .
    2. Stai salvando il file (il secondo file creato in # 1 sopra) come Name e Name2 , poi si sta nuovamente a Kill il Name , dopo l'operazione SaveAs . Ciò sembra inutile e / o involontario.
    3. Vedo che stai salvando l'intera cartella di lavoro, non solo il foglio di lavoro singolo. È quello che è destinato? In caso contrario, questo potrebbe essere gestito utilizzando i Sheets(x).SaveAs... o Sheets("Section " & x).SaveAs...
    4. Stai facendo ActiveWindow.Close all'interno del loop, che sembra sospetto, dal momento che sei il primo Salvare il ActiveWorkbook .

    Una soluzione?

    Una soluzione di mapping come l'altra risposta o l'utilizzo di un object Dictionary (la mia preferenza) è applicabile qui, ma non può essere implementato correttamente finché il resto del codice non effettua effettivamente ciò che si prevede di fare e non contiene errori logici o altri problemi come potenzialmente menzionati sopra.

    Di seguito modificata dalla risposta di @ ASH sopra, per cui avrai bisogno della matrix di secfol fornita in quella risposta (vedi sotto per un modo per includerlo):

      For i = 1 to 6 ' ### OTHER STUFF IN YOUR CODE... ' ' ' ' ### Save the sheet at this loop iteration: With Sheets("Section " & x) .SaveAs Filename:=fName & "\" & secfol(x) & "_" & DateString, _ FileFormat:=.Parent.FileFormat, _ Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False End With Next i 

    Quindi creare una function separata, come così:

     Function secfol(i as Long) secfol = Array("", _ "Section 1 Jobs Released Last Week (excludes NRT Jobs)", _ "Section 2 Jobs Created Last Week (excludes NRT Jobs)", _ "Section 3 Late Jobs", _ "Section 4 Unnegotiated Jobs", _ "Section 5 Jobs To Go (Excludes NRT Jobs)", _ "Section 6 Jobs To Go (NRT Jobs)")(i) End Function 
    Microsoft Office Excel Spreadsheet è il miglior software di Office, Excel VBA e formule Excel rendono il foglio di calcolo più veloce.