Makro funktioniert nicht mehr richtig
#1
Hallo ihr Experten!
Ich brauch mal wieder eure hilfe!

Ich muß ca. 400 Tabellen ändern. Für die Änderungen habe ich mir ein Makro aufgezeichnet und aus einen alten Makro was hinzugefügt.
Nach dem durchlaufen des Cods bekomme ich einen Laufzeitfehler"9" Index auserhalb des gültigen Bereiches.
Was habe ich falsch gemacht?


Code:
Sub Planändern()
' Planändern Makro
'
Application.ScreenUpdating = False
   Dim Maschinen
   Dim ordner
   Dim y As Integer
   Const Verzeichnis = "F:\Wartungspläne\Boy\"
   
'     Maschine = Array("Boy 30.01 M\Boy 30.01 M - S 1485 EP.xls", _
                    "Boy 50.01 M\Boy 50.01 M - S 1409 EP.xls")
   
   
   Maschine = Array("Boy 30.01 M\", _
                    "Boy 50.01 M\")
   ordner = Array("Boy 30.01 M - S 1485 EP.xls", _
                    "Boy 50.01 M - S 1409 EP.xls")

   For y = 0 To UBound(Maschine) & UBound(ordner)
     
       Application.StatusBar = "Öffne " & Maschine(y) & ordner(y) & "...."
       Workbooks.Open Filename:=Verzeichnis & Maschine(y) & ordner(y)
           
          ' Tabellenblatt auswählen
 '          Dim name As String
  '         name = DieseArbeitsmappe.Sheets(1) '.Range("QUARTALE").Offset(DieseArbeitsmappe.Sheets(2).Range("Quartal").Value - 1, 0).Value
   '        ActiveWorkbook.Sheets(name).Select
          ' Jahr einfügen
   '        Range("H1").FormulaR1C1 = DieseArbeitsmappe.Sheets(3).Range("Jahre").Offset(DieseArbeitsmappe.Sheets(2).Range("Jahr").Value - 1, 0)
    '       Application.StatusBar = "Speichere " & maschine(y) & "...."
     '      ActiveWindow.SelectedSheets.PrintOut Copies:=1
      '     With ActiveWorkbook
       '        .Save
        '       .Close
         '  End With
'
       Blatt = ordner(y)

   Windows("Vorlage_SGM11.xlsm").Activate
   Sheets("Wartungsplan").Select
   
    Cells.Select
    Selection.Copy
   
   
   Workbooks(Blatt).Activate
       Sheets("Wartungsplan").Select
           Cells.Select
           ActiveSheet.Paste
           ActiveWindow.SmallScroll Down:=-27
           Range("A2").Select
           Application.CutCopyMode = False
           ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
           Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillDefault
           Range("A2:A8").Select
           Range("B2").Select
           ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
           Selection.AutoFill Destination:=Range("B2:C2"), Type:=xlFillDefault
           Range("B2:C2").Select
           Selection.AutoFill Destination:=Range("B2:C8"), Type:=xlFillDefault
           Range("B2:C8").Select
           Range("C6").Select
           Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
           Range("C6:D6").Select
           Selection.AutoFill Destination:=Range("C6:D8"), Type:=xlFillDefault
           Range("C6:D8").Select
           Range("D2:G2").Select
           ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
           Range("D2:G2").Select
           Selection.AutoFill Destination:=Range("D2:G5"), Type:=xlFillDefault
           Range("D2:G5").Select
           Range("D5:G5").Select
           Selection.NumberFormat = "m/d/yyyy"
           Range("E30").Select
           ActiveCell.FormulaR1C1 = "=IF(Kopf!R6C1>"" "",""x"","" "")"
           Range("B30:D30").Select
           ActiveCell.FormulaR1C1 = _
               "=IF(Kopf!R6C1>"" "",""Überprüfung der Sicherheitsschalter am Roboter"","" "")"
           Range("D6").Select
   
Windows("Vorlage_SGM11.xlsm").Activate
   Sheets("Kontrollkarte 1. Quartal").Select
           Cells.Select
           Selection.Copy
Workbooks(Blatt).Activate
   Sheets("Kontrollkarte 1. Quartal").Select
     
      Cells.Select
      ActiveSheet.Paste
      Range("A2").Select
      Application.CutCopyMode = False
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillDefault
      Range("A2:A8").Select
      Range("B2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("B2:C2"), Type:=xlFillDefault
      Range("B2:C2").Select
      Selection.AutoFill Destination:=Range("B2:C8"), Type:=xlFillDefault
      Range("B2:C8").Select
      Range("C2").Select
      Range("C6").Select
      Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
      Range("C6:D6").Select
      Selection.AutoFill Destination:=Range("C6:D8"), Type:=xlFillDefault
      Range("C6:D8").Select
      Range("D2:G2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("D2:G5"), Type:=xlFillDefault
      Range("D2:G5").Select
      Range("D5:G5").Select
      Selection.NumberFormat = "m/d/yyyy"
      Range("E30").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!R6C1>"" "",""x"","" "")"
      Range("B30:D30").Select
      ActiveCell.FormulaR1C1 = _
          "=IF(Kopf!R6C1>"" "",""Überprüfung der Sicherheitsschalter am Roboter"","" "")"
 
 Windows("Vorlage_SGM11.xlsm").Activate
   Range("A1:G1").Select
   Sheets("Kontrollkarte 2. Quartal").Select
       Cells.Select
       Selection.Copy
 Workbooks(Blatt).Activate
   Sheets("Kontrollkarte 2. Quartal").Select
     
      Cells.Select
      ActiveSheet.Paste
      Range("A2").Select
      Application.CutCopyMode = False
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillDefault
      Range("A2:A8").Select
      Range("B2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("B2:C2"), Type:=xlFillDefault
      Range("B2:C2").Select
      Selection.AutoFill Destination:=Range("B2:C8"), Type:=xlFillDefault
      Range("B2:C8").Select
      Range("C2").Select
      Range("C6").Select
      Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
      Range("C6:D6").Select
      Selection.AutoFill Destination:=Range("C6:D8"), Type:=xlFillDefault
      Range("C6:D8").Select
      Range("D2:G2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("D2:G5"), Type:=xlFillDefault
      Range("D2:G5").Select
      Range("D5:G5").Select
      Selection.NumberFormat = "m/d/yyyy"
      Range("E30").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!R6C1>"" "",""x"","" "")"
      Range("B30:D30").Select
      ActiveCell.FormulaR1C1 = _
          "=IF(Kopf!R6C1>"" "",""Überprüfung der Sicherheitsschalter am Roboter"","" "")"
 
 Windows("Vorlage_SGM11.xlsm").Activate
   Range("A1:G1").Select
   Sheets("Kontrollkarte 3. Quartal").Select
       Cells.Select
       Selection.Copy
 Workbooks(Blatt).Activate
   Sheets("Kontrollkarte 3. Quartal").Select
     
      Cells.Select
      ActiveSheet.Paste
      Range("A2").Select
      Application.CutCopyMode = False
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillDefault
      Range("A2:A8").Select
      Range("B2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("B2:C2"), Type:=xlFillDefault
      Range("B2:C2").Select
      Selection.AutoFill Destination:=Range("B2:C8"), Type:=xlFillDefault
      Range("B2:C8").Select
      Range("C2").Select
      Range("C6").Select
      Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
      Range("C6:D6").Select
      Selection.AutoFill Destination:=Range("C6:D8"), Type:=xlFillDefault
      Range("C6:D8").Select
      Range("D2:G2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("D2:G5"), Type:=xlFillDefault
      Range("D2:G5").Select
      Range("D5:G5").Select
      Selection.NumberFormat = "m/d/yyyy"
      Range("E30").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!R6C1>"" "",""x"","" "")"
      Range("B30:D30").Select
      ActiveCell.FormulaR1C1 = _
          "=IF(Kopf!R6C1>"" "",""Überprüfung der Sicherheitsschalter am Roboter"","" "")"
Windows("Vorlage_SGM11.xlsm").Activate
   Range("A1:G1").Select
   Sheets("Kontrollkarte 4. Quartal").Select
       Cells.Select
       Selection.Copy
 Workbooks(Blatt).Activate
   Sheets("Kontrollkarte 4. Quartal").Select
     
      Cells.Select
      ActiveSheet.Paste
      Range("A2").Select
      Application.CutCopyMode = False
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillDefault
      Range("A2:A8").Select
      Range("B2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("B2:C2"), Type:=xlFillDefault
      Range("B2:C2").Select
      Selection.AutoFill Destination:=Range("B2:C8"), Type:=xlFillDefault
      Range("B2:C8").Select
      Range("C2").Select
      Range("C6").Select
      Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
      Range("C6:D6").Select
      Selection.AutoFill Destination:=Range("C6:D8"), Type:=xlFillDefault
      Range("C6:D8").Select
      Range("D2:G2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("D2:G5"), Type:=xlFillDefault
      Range("D2:G5").Select
      Range("D5:G5").Select
      Selection.NumberFormat = "m/d/yyyy"
      Range("E30").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!R6C1>"" "",""x"","" "")"
      Range("B30:D30").Select
      ActiveCell.FormulaR1C1 = _
          "=IF(Kopf!R6C1>"" "",""Überprüfung der Sicherheitsschalter am Roboter"","" "")"
   With ActiveWorkbook
        .Save
        .Close
   End With
  Next
 
   Application.StatusBar = False
   Application.ScreenUpdating = True
   
   
End Sub


Angehängte Dateien
.xlsm   Vorlage_SGM11.xlsm (Größe: 188,31 KB / Downloads: 1)
.xls   Boy 50.01 M - S 1409 EP.xls (Größe: 105 KB / Downloads: 0)
.xls   Boy 30.01 M - S 1485 EP.xls (Größe: 105,5 KB / Downloads: 0)
mfg
Michael
:98:

WIN 10  Office 2019
Top
#2
Hallo Michael,

ich habe mir deine Dateien nicht heruntergeladen und auch deinen Code nicht analysiert (da ist mir viel zu viel select drin) aber der Laufzeitfehler 9 kommt unter anderen auch dann, wenn ein Tabellennamen nicht existiert. Vielleicht solltest Du auch zeigen, in welcher Codezeile der Fehler kommt.
Gruß Stefan
Win 10 / Office 2016
Top
#3
Hallo Stefan!

Danke für den hinweis.

Also ich versuche es etwas genauer zu beschreiben

Im oberen teil ist ein Code den ich geändert habe, der übsprüngliche Code ist für das ändern einer Zahle und zum Ausdrucken.
Dieser funktioniert auch so wie er unten dargestellt wird.

Code:
Sub Boy()
   Application.ScreenUpdating = False
   Dim Maschinen
   Dim y As Integer
   Const Verzeichnis = "F\Wartungspläne\Boy\"
   
   maschine = Array("Boy 30.01 M\Boy 30.01 M - S 1485 EP.xls", _
                    "Boy 50.01 M\Boy 50.01 M - S 1409 EP.xls")
                   

   For y = 0 To UBound(maschine)
       Application.StatusBar = "Öffne " & maschine(y) & "...."
       Workbooks.Open Filename:=Verzeichnis & maschine(y)
           
          ' Tabellenblatt auswählen
           Dim name As String
           name = DieseArbeitsmappe.Sheets(3).Range("QUARTALE").Offset(DieseArbeitsmappe.Sheets(2).Range("Quartal").Value - 1, 0).Value
           ActiveWorkbook.Sheets(name).Select
          ' Jahr einfügen
           Range("H1").FormulaR1C1 = DieseArbeitsmappe.Sheets(3).Range("Jahre").Offset(DieseArbeitsmappe.Sheets(2).Range("Jahr").Value - 1, 0)
           Application.StatusBar = "Speichere " & maschine(y) & "...."
           ActiveWindow.SelectedSheets.PrintOut Copies:=1
           With ActiveWorkbook
               .Save
               .Close
           End With
           
    Next
   Application.StatusBar = False
   Application.ScreenUpdating = True

End Sub
Jetzt habe ich mir gedacht, einfach erweitern und schon biste fertig.

Mußte aber dann dies noch ändern.

Code:
    Maschine = Array("Boy 30.01 M\", _
                     "Boy 50.01 M\")
    ordner = Array("Boy 30.01 M - S 1485 EP.xls", _
                     "Boy 50.01 M - S 1409 EP.xls")   ' zusätzlich eingebaut damit die Tabellenblätter geöffnet werden

    For y = 0 To UBound(Maschine) & UBound(ordner)     ' geändert    " Vieleicht ist auch hier der Fehler?"
       
        Application.StatusBar = "Öffne " & Maschine(y) & ordner(y) & "...."
        Workbooks.Open Filename:=Verzeichnis & Maschine(y) & ordner(y)

Damit dies dann funktioniert.
Code:
     Blatt = ordner(y)          'eingebaut für Tabellenblatt sonst öffnet sich Workbooks(Blatt).Activate NICHT
 
   Windows("Vorlage_SGM11.xlsm").Activate
   Sheets("Wartungsplan").Select
   
    Cells.Select
    Selection.Copy
   
   Workbooks(Blatt).Activate
       Sheets("Wartungsplan").Select

Jetzt bekomme ich halb den Laufzeitfehler im oberen Teil

Mit dem select ist halb vom aufzeichnen :30: :30: :30: :30:

Vieleicht kann man ja das doch etwas anders gestalten, weil es sich ja ständig wiederholt Huh .
mfg
Michael
:98:

WIN 10  Office 2019
Top
#4
Hallo!

Wie immer was vergessen noch mitzuteilen.

Der code wird wie er soll zweimal durchlaufen. Nach dem zweitenmal ist er fertig uns sollte aufhören.
Doch dann bekomme ich den laufzeitfehler. Ich glaue es liegt an dieser Zeile

 For y = 0 To UBound(Maschine) & UBound(ordner)

Weil wie eben schon beschrieben funktioniert der ursprüngliche Code ja mit dieser Zeile

 For y = 0 To UBound(Maschine)

Ich hoffe das hilft ein wenig.
mfg
Michael
:98:

WIN 10  Office 2019
Top
#5
Hallo Michael,

Du hast richtig erfasst. Deine Codezeile For y = 0 To UBound(Maschine) & UBound(ordner) ist falsch. Nehme deinen alten Code und ändere im diesem nur eine Codezeile ab und zwar die

Code:
      Blatt = Mid(maschine(y), InStrRev(maschine(y), "\") + 1)

und tue dir den Gefallen und entferne das Select. Wie das geht, wird dir hier gezeigt.

Nachtrag: Dein Code

Code:
Sub Planändern()
' Planändern Makro
'
Application.ScreenUpdating = False
   Dim Maschinen
   Dim y As Integer
   Const Verzeichnis = "F:\Wartungspläne\Boy\"
  
     maschine = Array("Boy 30.01 M\Boy 30.01 M - S 1485 EP.xls", _
                    "Boy 50.01 M\Boy 50.01 M - S 1409 EP.xls")
  

   For y = 0 To UBound(maschine)
    
       Application.StatusBar = "Öffne " & maschine(y) & "...."
       Workbooks.Open Filename:=Verzeichnis & maschine(y)
          
          ' Tabellenblatt auswählen
'          Dim name As String
  '         name = DieseArbeitsmappe.Sheets(1) '.Range("QUARTALE").Offset(DieseArbeitsmappe.Sheets(2).Range("Quartal").Value - 1, 0).Value
   '        ActiveWorkbook.Sheets(name).Select
          ' Jahr einfügen
   '        Range("H1").FormulaR1C1 = DieseArbeitsmappe.Sheets(3).Range("Jahre").Offset(DieseArbeitsmappe.Sheets(2).Range("Jahr").Value - 1, 0)
    '       Application.StatusBar = "Speichere " & maschine(y) & "...."
     '      ActiveWindow.SelectedSheets.PrintOut Copies:=1
      '     With ActiveWorkbook
       '        .Save
        '       .Close
         '  End With
'
       Blatt = Mid(maschine(y), InStrRev(maschine(y), "\") + 1)

   Windows("Vorlage_SGM11.xlsm").Activate
   Sheets("Wartungsplan").Select
  
    Cells.Select
    Selection.Copy
  
  
   Workbooks(Blatt).Activate
       Sheets("Wartungsplan").Select
           Cells.Select
           ActiveSheet.Paste
           ActiveWindow.SmallScroll Down:=-27
           Range("A2").Select
           Application.CutCopyMode = False
           ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
           Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillDefault
           Range("B2").Select
           ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
           Selection.AutoFill Destination:=Range("B2:C2"), Type:=xlFillDefault
           Range("B2:C2").Select
           Selection.AutoFill Destination:=Range("B2:C8"), Type:=xlFillDefault
           Range("C6").Select
           Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
           Range("C6:D6").Select
           Selection.AutoFill Destination:=Range("C6:D8"), Type:=xlFillDefault
           Range("D2:G2").Select
           ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
           Range("D2:G2").Select
           Selection.AutoFill Destination:=Range("D2:G5"), Type:=xlFillDefault
           Range("D5:G5").Select
           Selection.NumberFormat = "m/d/yyyy"
           Range("E30").Select
           ActiveCell.FormulaR1C1 = "=IF(Kopf!R6C1>"" "",""x"","" "")"
           Range("B30:D30").Select
           ActiveCell.FormulaR1C1 = _
               "=IF(Kopf!R6C1>"" "",""Überprüfung der Sicherheitsschalter am Roboter"","" "")"
           Range("D6").Select
  
Windows("Vorlage_SGM11.xlsm").Activate
   Sheets("Kontrollkarte 1. Quartal").Select
           Cells.Select
           Selection.Copy
Workbooks(Blatt).Activate
   Sheets("Kontrollkarte 1. Quartal").Select
    
      Cells.Select
      ActiveSheet.Paste
      Range("A2").Select
      Application.CutCopyMode = False
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillDefault
      Range("B2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("B2:C2"), Type:=xlFillDefault
      Range("B2:C2").Select
      Selection.AutoFill Destination:=Range("B2:C8"), Type:=xlFillDefault
      Range("C6").Select
      Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
      Range("C6:D6").Select
      Selection.AutoFill Destination:=Range("C6:D8"), Type:=xlFillDefault
      Range("D2:G2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("D2:G5"), Type:=xlFillDefault
      Range("D5:G5").Select
      Selection.NumberFormat = "m/d/yyyy"
      Range("E30").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!R6C1>"" "",""x"","" "")"
      Range("B30:D30").Select
      ActiveCell.FormulaR1C1 = _
          "=IF(Kopf!R6C1>"" "",""Überprüfung der Sicherheitsschalter am Roboter"","" "")"

Windows("Vorlage_SGM11.xlsm").Activate
   Range("A1:G1").Select
   Sheets("Kontrollkarte 2. Quartal").Select
       Cells.Select
       Selection.Copy
Workbooks(Blatt).Activate
   Sheets("Kontrollkarte 2. Quartal").Select
    
      Cells.Select
      ActiveSheet.Paste
      Range("A2").Select
      Application.CutCopyMode = False
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillDefault
      Range("B2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("B2:C2"), Type:=xlFillDefault
      Range("B2:C2").Select
      Selection.AutoFill Destination:=Range("B2:C8"), Type:=xlFillDefault
      Range("C6").Select
      Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
      Range("C6:D6").Select
      Selection.AutoFill Destination:=Range("C6:D8"), Type:=xlFillDefault
      Range("D2:G2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("D2:G5"), Type:=xlFillDefault
      Range("D5:G5").Select
      Selection.NumberFormat = "m/d/yyyy"
      Range("E30").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!R6C1>"" "",""x"","" "")"
      Range("B30:D30").Select
      ActiveCell.FormulaR1C1 = _
          "=IF(Kopf!R6C1>"" "",""Überprüfung der Sicherheitsschalter am Roboter"","" "")"

Windows("Vorlage_SGM11.xlsm").Activate
   Range("A1:G1").Select
   Sheets("Kontrollkarte 3. Quartal").Select
       Cells.Select
       Selection.Copy
Workbooks(Blatt).Activate
   Sheets("Kontrollkarte 3. Quartal").Select
    
      Cells.Select
      ActiveSheet.Paste
      Range("A2").Select
      Application.CutCopyMode = False
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillDefault
      Range("B2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("B2:C2"), Type:=xlFillDefault
      Range("B2:C2").Select
      Selection.AutoFill Destination:=Range("B2:C8"), Type:=xlFillDefault
      Range("C6").Select
      Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
      Range("C6:D6").Select
      Selection.AutoFill Destination:=Range("C6:D8"), Type:=xlFillDefault
      Range("D2:G2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("D2:G5"), Type:=xlFillDefault
      Range("D5:G5").Select
      Selection.NumberFormat = "m/d/yyyy"
      Range("E30").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!R6C1>"" "",""x"","" "")"
      Range("B30:D30").Select
      ActiveCell.FormulaR1C1 = _
          "=IF(Kopf!R6C1>"" "",""Überprüfung der Sicherheitsschalter am Roboter"","" "")"
Windows("Vorlage_SGM11.xlsm").Activate
   Range("A1:G1").Select
   Sheets("Kontrollkarte 4. Quartal").Select
       Cells.Select
       Selection.Copy
Workbooks(Blatt).Activate
   Sheets("Kontrollkarte 4. Quartal").Select
    
      Cells.Select
      ActiveSheet.Paste
      Range("A2").Select
      Application.CutCopyMode = False
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillDefault
      Range("B2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("B2:C2"), Type:=xlFillDefault
      Range("B2:C2").Select
      Selection.AutoFill Destination:=Range("B2:C8"), Type:=xlFillDefault
      Range("C6").Select
      Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
      Range("C6:D6").Select
      Selection.AutoFill Destination:=Range("C6:D8"), Type:=xlFillDefault
      Range("D2:G2").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!RC>0,Kopf!RC,"""")"
      Selection.AutoFill Destination:=Range("D2:G5"), Type:=xlFillDefault
      Range("D5:G5").Select
      Selection.NumberFormat = "m/d/yyyy"
      Range("E30").Select
      ActiveCell.FormulaR1C1 = "=IF(Kopf!R6C1>"" "",""x"","" "")"
      Range("B30:D30").Select
      ActiveCell.FormulaR1C1 = _
          "=IF(Kopf!R6C1>"" "",""Überprüfung der Sicherheitsschalter am Roboter"","" "")"
   With ActiveWorkbook
        .Save
        .Close
   End With
  Next

   Application.StatusBar = False
   Application.ScreenUpdating = True
  
  
End Sub
Gruß Stefan
Win 10 / Office 2016
Top
#6
Hallo Stefan!

Suuuuuuuuuper!
Tausend dank für die Hilfe!

Es funktioniert, ich werde morgen mal das select raus tun.
Vieleicht kann man dann den Code nochmal etwas verkürzen!
Die fleiss Arbeit mache ich natürlich.
Gedanke war es mit einer schleife zu belegen, muss mich aber erstmal noch schlau machen wie am besten.
Ich will ja dazu Lernen.

Dies gehöhrt auch mit zu dem Projekt  "CombBox in abhängikeit"
Wo bei ich dir auch nochmal Danke sage!  
:100:
mfg
Michael
:98:

WIN 10  Office 2019
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste