Öffnen und Speichern neuer Arbeitsmappen - VBA

Question

Also ich weiß, es gab Fragen dazu vorher, aber keiner scheint die Probleme, die ich habe, explizit zu lösen. Effektiv versuche ich, eine neue Arbeitsmappe zu erstellen, Daten zu kopieren und einzufügen und diese neue Arbeitsmappe unter einem neuen Dateinamen zu speichern. Egal was ich mache, ich bekomme verschiedene Arten von Fehlermeldungen.

Hier ist mein Code. Jede Hilfe wird sehr geschätzt!

Private Sub DoStuff() 

CurrentFile = "June_Files_macros_new.xlsm" 
NewFile = "Train10_June01.xls" 

Workbooks.Add 


'Save New Workbook 
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewFile 

For i = 2 To 55 
    If Cells(i, 3) = Cells(i - 1, 3) And Cells(i, 13) = Cells(i - 1, 13) Then 
      Workbooks(CurrentFile).Worksheets("Sheet1").Rows(i).Copy _ 
      Workbooks(NewFile).Worksheets("Sheet1").Rows(i) 
    Else: Workbooks(NewFile).SaveAs ThisWorkbook.Path & "\" & "New_Name" 
    End If  
Next i 

End Sub 

Es scheint mir, dass die „Neuer_Name“ meine Probleme alles verursacht, aber ich bin offen, etwas zu ändern, die diese Arbeit ermöglicht.

Vielen Dank! Zach

ps Ich bin relativ neu zu VBA also bitte versuchen Sie, irgendwelche Erklärungen etwas einfach zu halten!

Answer 1

Try this:

Private Sub DoStuff() 
    Dim CurrentFile As String 
    Dim NewFile As String 
    Dim i As Long 
    Dim wb As Workbook 

    CurrentFile = "June_Files_macros_new.xlsm" 
    NewFile = "Train10_June01.xls" 

    Set wb = Workbooks.Add 
    wb.SaveAs Workbooks(CurrentFile).Path & "\" & NewFile 

    For i = 2 To 55 
     If Cells(i, 3) = Cells(i - 1, 3) And Cells(i, 13) = Cells(i - 1, 13) Then 
      Workbooks(CurrentFile).Sheets("Sheet1").Rows(i).Copy Workbooks(NewFile).Worksheets("Sheet1").Rows(i) 
     Else 
      Set wb = Workbooks(NewFile) 
      wb.SaveAs Workbooks(CurrentFile).Path & "\" & "New_name.xls" 
      Exit For 
     End If 
    Next i 

End Sub 

ich diesen Block setzen:

Else 
    Set wb = Workbooks(NewFile) 
    wb.SaveAs Workbooks(CurrentFile).Path & "\" & "New_name.xls" 
    Exit For 

Weil jedes Mal, wenn die Bedingung in Ihrem Wenn eine falsche Antwort gibt, wird versuchen, die Arbeitsbücher (NewFile) mit sparen Derselbe Name "New_name.xls". Dies führt zu einem Fehler, da Excel keine Dateien mit demselben Namen speichern kann.

Aber ich bin mir nicht sicher, was Sie mit dieser Else-Bedingung haben wollten.

Answer 2

Mit Ihrer Hilfe schaffte ich es, etwas zu schaffen, das tat, was ich wollte. Vielen Dank !!!

Private Sub DoStuff() 

Application.DisplayAlerts = False 

'Create New Workbook 

Dim Count As Integer 

CurrentFile = "June_Files_macros_new.xlsm" 
NewFile = "Train" & CStr(Cells(2, 13)) & "_" & CStr(Cells(2, 3)) & ".xls" 

Workbooks.Add 


'Save New Workbook 
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewFile 

'Select top row of data and insert into spreadsheed!!!!! 
Workbooks(CurrentFile).Worksheets("Sheet1").Rows(2).Copy 
Workbooks(NewFile).Worksheets("Sheet1").Rows(2).PasteSpecial xlPasteValues 


Count = 3 



For i = 3 To 12802 

'if Date and Train Number are equal, Then copy and paste the i th row 
'else, save new file, create another new file, save 

    If Cells(i, 3) = Cells(i - 1, 3) And Cells(i, 13) = Cells(i - 1, 13) Then 
      Workbooks(CurrentFile).Worksheets("Sheet1").Rows(i).Copy 
      Workbooks(NewFile).Worksheets("Sheet1").Rows(Count).PasteSpecial xlPasteValues 
      Count = Count + 1 

    Else: Workbooks(CurrentFile).Worksheets("Sheet1").Rows(1).Copy 
      Workbooks(NewFile).Worksheets("Sheet1").Rows(1).PasteSpecial xlPasteValues 
      Workbooks(NewFile).SaveAs ThisWorkbook.Path & "\" & "Train" & CStr(Cells(i - 1, 13)) & "_" & CStr(Cells(i - 1, 3)) & ".xls" 
      Workbooks(NewFile).Close 

      Workbooks.Add 
      NewFile = "Train" & CStr(Cells(i, 13)) & "_" & CStr(Cells(i, 3)) & ".xls" 
      ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewFile 

      Workbooks(CurrentFile).Worksheets("Sheet1").Rows(i).Copy 
      Workbooks(NewFile).Worksheets("Sheet1").Rows(2).PasteSpecial xlPasteValues 

      Count = 3 
    End If 

Next i 

Workbooks(CurrentFile).Worksheets("Sheet1").Rows(1).Copy 
Workbooks(NewFile).Worksheets("Sheet1").Rows(1).PasteSpecial xlPasteValues 

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NewFile 

Workbooks(NewFile).Close