Datei mit VBA-Schleife speichern

[Heinz Ulm]

Hallo VBA-Freunde,

ich brauche wieder einmal eure Hilfe.

Ich habe eine Musterdatei, in dem z.B. 32 Mitarbeiter stehen.
Zu Jahresbeginn soll aus der Musterdatei (z.B. Muster_Arbeitszeiterfassung.xlsm) per Schleife die Musterdatei unter Heinz_Ulm_Arbeitszeiterfassung.XLSM und so weiter gespeichert werden. Die einmalige Speicherung ist kein Problem, das habe ich und es geht:

Code:

Sub NeueMA()
'
' Neueinrichtung Makro
'
Speichername = Worksheets("Datenblatt").Range("K12").Value
Datendatei = Worksheets("Datenblatt").Range("K11").Value
AktiveDatei = Worksheets("Datenblatt").Range("K10").Value
Dateiname = Worksheets("Datenblatt").Range("K8").Value & ArbDatei
Ursprung = Worksheets("Datenblatt").Range("K13").Value & ArbDatei
ArbDatei = Worksheets("Datenblatt").Range("K14").Value & ArbDatei
  
'ActiveWorkbook.Save
   If Range("C5").Value = "" Then
   MsgBox ("Kein Mitarbeiter ausgew?hlt")
   Exit Sub
   End If
      
    ActiveWorkbook.SaveAs Filename:=Speichername
'    Windows("DatenMuster.xlsx").Activate
'    ActiveWorkbook.SaveAs Filename:=Datendatei
'    Windows(ArbDatei).Activate
    Worksheets("Datenblatt").Select
'    Range("I18").Value = "Hallo"
    ActiveSheet.Shapes("CommandButton1").Delete
    ActiveWorkbook.Save
    Workbooks.Open Filename:=Ursprung
    Windows(ArbDatei).Activate
    ActiveWorkbook.Save
   ActiveWorkbook.Close
  
   
   
End Sub

Wie kriege ich jetzt eine Schleife hin. Wenn ich die Ursprungsdatei schließe ist mein Code beendet. Meine Versuche in dem Stil:

Code:

Sub NeueMA2()
'
' Neueinrichtung Makro
'

Speichername = Worksheets("Datenblatt").Range("K12").Value
Datendatei = Worksheets("Datenblatt").Range("K11").Value
AktiveDatei = Worksheets("Datenblatt").Range("K10").Value
Dateiname = Worksheets("Datenblatt").Range("K8").Value & ArbDatei
Ursprung = Worksheets("Datenblatt").Range("K13").Value & ArbDatei
ArbDatei = Worksheets("Datenblatt").Range("K14").Value & ArbDatei
 
'ActiveWorkbook.Save

   If Range("C5").Value = "" Then
   MsgBox ("Kein Mitarbeiter ausgew?hlt")
   Exit Sub
   End If
     
   If Worksheets("Datenblatt").Range("L7").Value = 1 Then
       ActiveWorkbook.SaveAs Filename:=Speichername
       
       Worksheets("Datenblatt").Select
       ActiveSheet.Shapes("NeueMA").Delete
       ActiveSheet.Protect ("cwe1974")
       ActiveWorkbook.Save
       Workbooks.Open Filename:=Ursprung
       Windows(ArbDatei).Activate
       ActiveWorkbook.Save
       ActiveWorkbook.Close
       Exit Sub
       
   End If

   If Worksheets("Datenblatt").Range("L7").Value = 2 Then
   For I = 9 To Worksheets("Personaldaten").Range("A1").Value
   
   MANR = Worksheets("Personaldaten").Range("B" & I).Value
   Worksheets("Datenblatt").Range("C5").Value = MANR
       ActiveWorkbook.SaveAs Filename:=Speichername
       Worksheets("Datenblatt").Select
       ActiveSheet.Shapes("NeueMA").Delete
       ActiveSheet.Protect ("cwe1974")
       ActiveWorkbook.Save
'        Workbooks.Open Filename:=Ursprung
'        Windows(ArbDatei).Activate
'        ActiveWorkbook.Save
'        ActiveWorkbook.Close
 Next I
       
   End If
   
   
End Sub

brachten mich auch nicht weiter.

[Gast 123]

Hallo

ich habe beide Codes noch nicht so richtig verstanden??  Man baut bei einem Haus zuerst das Fundament, dann kommt das Dach!

Dateiname = Worksheets("Datenblatt").Range("K8").Value & ArbDatei
Ursprung = Worksheets("Datenblatt").Range("K13").Value & ArbDatei
ArbDatei = Worksheets("Datenblatt").Range("K14").Value & ArbDatei

 
Wenn ich mir den Code so ansehe wird bei den beiden ersten Variablen ein Wert angehangen, der erst zum Schluss gebildet wird???  Und das noch mit der eigenen Variablen??  Det ist mir gelinde gesagt - dreimal zu hoch!!  Nennt man bei Formeln Zirkelbezug!!  Funktioniert aber nicht!!

Hat der Code so jemals richtig funktioniert??  Ich zweifele daran.  In der Schleife fiel mir auf das die With Klammer fehlt:  With ThisWorkbook

Ohne With Ausdruck und dem Punkt vor Worksheet beziehst du nach dem ersten Save die Daten aus dem gerade Aktiven Workbook. Da sind aber keine Personaldaten drin!!  Deshalb kann man auf With nicht verzichten, oder muss vor jedem einzelnen Worksheet "ThisWorkbook." davor schreiben!  Mir faellt gerade auf das du 32 mal den Button löschen willst, macht wennig Sinn.  Nimm doch die erste Mappe mit gelöschtem Button und speichere die mit dem jeweiligen Personal Namen neu ab. Ist aber zu spaet um aus dem Kopf heraus das Makro auf die schnelle zu aendern.

Ich hoffe mein Tipp hilft weiter, sonst erarbeiten wir ein neues Makro in Zusammenarbeit. 

mfg  Gast 123

Code:

With ThisWorkbook
  If .Worksheets("Datenblatt").Range("L7").Value = 2 Then
  For I = 9 To .Worksheets("Personaldaten").Range("A1").Value
 
  MANR = .Worksheets("Personaldaten").Range("B" & I).Value
  .Worksheets("Datenblatt").Range("C5").Value = MANR
      ActiveWorkbook.SaveAs Filename:=Speichername
      Worksheets("Datenblatt").Select
      ActiveSheet.Shapes("NeueMA").Delete
      ActiveSheet.Protect ("cwe1974")
      ActiveWorkbook.Save
'        Workbooks.Open Filename:=Ursprung
'        Windows(ArbDatei).Activate
'        ActiveWorkbook.Save
'        ActiveWorkbook.Close
 Next I
End With

[Heinz Ulm]

Hallo Gast,

vielen Dank für deinen Code, er läuft aber nicht. Das macht auch nichts aus, da ich das Problem anders gelöst habe.

Mein Problem lag im Schließen der Arbeitsmappe und dem neuen Öffnen der Ursprungsmappe. Da war natürlich der Code weg.

So läuft das jetzt:

Code:

Sub NeueMA2()


Speichername = Worksheets("Datenblatt").Range("K12").Value
AktiveDatei = Worksheets("Datenblatt").Range("K10").Value
Ursprung = Worksheets("Datenblatt").Range("K13").Value & ArbDatei
 
   If Range("C5").Value = "" Then
   MsgBox ("Kein Mitarbeiter ausgew?hlt")
   Exit Sub
   End If
     
   Sheets(Array("Feiertage", "Ferien", "Jahreskalender", "Kennbuchstaben", _
       "Personaldaten")).Visible = False

   Worksheets("Berechnung").Rows("1:25").EntireRow.Hidden = True
   Sheets("Datenblatt").Select
       
   If Worksheets("Datenblatt").Range("L7").Value = 1 Then
       ActiveSheet.Shapes.Range(Array("Option Button 4")).Delete
       ActiveSheet.Shapes.Range(Array("Option Button 5")).Delete
       ActiveSheet.Shapes.Range(Array("NeueMA")).Delete
       Range("L7").ClearContents
           
       ActiveWorkbook.SaveAs Filename:=Speichername
       
       Worksheets("Datenblatt").Select
       ActiveSheet.Protect ("cwe1974")
       ActiveWorkbook.Save
       ArbDatei = Worksheets("Datenblatt").Range("K14").Value
       Workbooks.Open Filename:=Ursprung
       Windows(ArbDatei).Activate
       ActiveWorkbook.Save
       ActiveWorkbook.Close
       Exit Sub
       
   End If

   If Worksheets("Datenblatt").Range("L7").Value = 2 Then

       ActiveSheet.Shapes.Range(Array("Option Button 4")).Delete
       ActiveSheet.Shapes.Range(Array("Option Button 5")).Delete
       ActiveSheet.Shapes.Range(Array("NeueMA")).Delete
       Range("L7").ClearContents
   
   
   For I = 9 To Worksheets("Personaldaten").Range("A1").Value
   
       MANR = Worksheets("Personaldaten").Range("B" & I).Value
       ActiveSheet.Unprotect ("cwe1974")

       Worksheets("Datenblatt").Range("C5").Value = MANR
       Speichername = Worksheets("Datenblatt").Range("K12").Value
       

       ActiveWorkbook.SaveAs Filename:=Speichername
       
       ActiveSheet.Protect ("cwe1974")
       
       ActiveWorkbook.Save
   Next I
   End If
       
       ArbDatei = Worksheets("Datenblatt").Range("K14").Value
       Workbooks.Open Filename:=Ursprung
'        MsgBox (ArbDatei)
       Windows(ArbDatei).Activate
       ActiveWorkbook.Save
       ActiveWorkbook.Close
       Worksheets("Datenblatt").Range("C5").Value = 0
   
End Sub

Vielen Dank nochmals.

Heinz