Zeilen mit VBA einfügen/löschen

[Andyle]

Hallo liebe Gemeinde

Ich habe eine Pivot-Tabelle mit Mitarbeiternamen (TB "Mitarbeiter" B5 + (+ = Eingaben nach unter)

Des weiternen habe ich ein TB "Dienstplan". Da stehen die Mitarbeiter als Zellenbezug aus "Mitarbeiter" in B9:B18 drin.

Nun mein Problem:

Die Mitarbeiteranzahl in TB "Mitarbeiter" lese ich mit =ANZAHL2(Tabelle240[Mitarbeiter]) aus.

Wenn ich jetzt im TB "Mitarbeiter" die Tabelle erweitere bzw. verkürze, soll sich der Mitarbeiterbereich im TB "Dienstplan" in der Zeilenanzahl
anpassen. (Zeile einfügen/löschen)
Alle Formeln/Bezüge müssen mit eingefügt werden!

Wie bekommt man sowas hin?

Danke Euch!

[Gast 123]

Hallo

hier mal eine Demo Datei wo diese Bedingung erfüllt ist.  Bitte das Makro in einer Testdatei testen.
Ich weiss nicht ob das löschen oder einfügen dazu führen kann, das Formeln ihren Bezug verlieren??

mfg Gast 123

[Andyle]

Ich habe jetzt folgenden Code, der in den Grundzügen eigendlich dass macht, wass er soll.

Nun meine Frage, wie kann man den Code verkürzen?

Wie kann ich Ihn anpassen, dass beim ersten ausführen alle Zeilen die fehlen mit .Value aus TB "Mitarbeiter" eingefügt werden?

Code:

Sub neuerMonat()

If ActiveSheet.Name = "Dienstplan" Then

   Worksheets("Dienstplan").Copy after:=Worksheets(Worksheets.Count)

   ActiveSheet.Name = "0" & Range("K3") + 1 & "." & Range("L3")
   ActiveSheet.Range("K3").Comment.Delete
   ActiveSheet.Range("K3").AddComment Text:="Es wurden bereits Monatsblätter angelegt!" & vbLf & "Bitte hier den Wert nicht ändern!" & vbLf & "Um weitere Monatsblätter zu erstellen, öffnen Sie das Monatsplatt mit dem letzten Monat."
   ActiveSheet.Range("K3").Comment.Shape.TextFrame.AutoSize = True
   Else
   
   ActiveSheet.Copy after:=Worksheets(Worksheets.Count)

   Worksheets(Worksheets.Count).Name = Format(DateAdd("m", 1, "01." & Worksheets(Worksheets.Count - 1).Name), "mm.yyyy")
   
   End If
   
   'Zeilen einfügen
   letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'Hier wir die letzte Zeile der Spalte B ermittelt
   letztezeile = letztezeile - 4
   MsgBox letztezeile
   'ActiveSheet.Range("W3") 'Anzahl der Mitarbeiter im TB "Mitarbeiter"
   
   If letztezeile < ActiveSheet.Range("W3") + 8 Then '9
   
   ActiveSheet.Range("B" & letztezeile).EntireRow.Insert
   
  Dim lngRowSource  As Long
  Dim lngRowTarget  As Long
 
  letztezeile_neu = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row - 4 'Hier wir die letzte Zeile der Spalte B ermittelt
  'MsgBox letztezeile_neu
 
  lngRowSource = letztezeile_neu
  lngRowTarget = letztezeile_neu - 1

  With ActiveSheet
    .Rows(lngRowSource).Cut
    .Rows(lngRowTarget).Insert Shift:=xlShiftDown
  End With
 
  ActiveSheet.Range("B" & letztezeile_neu) = Worksheets("Mitarbeiter").Range("B" & letztezeile_neu - 1).Value
   
  End If
   
   'Ende einfügen
   
   If ActiveSheet.Range("K3") = 12 Then
   ActiveSheet.Range("K3") = 1
   ActiveSheet.Range("L3") = Range("L3") + 1
   Else
   ActiveSheet.Range("K3") = Range("K3") + 1
   End If
   
   ActiveSheet.Range("C9:AG18").ClearContents
   
   Cells.EntireColumn.Hidden = False 'Blende alle Spalten ein
   
   'Spalten ausblenden
   If ActiveSheet.Range("H3") < 31 Then
   ActiveSheet.Columns("AG:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 30 Then
   ActiveSheet.Columns("AF:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 29 Then
   ActiveSheet.Columns("AE:AG").EntireColumn.Hidden = True
   End If
   'Ende Spalten ausblenden

End Sub

[Andyle]

Etwas mehr Ordnung

Code:

Sub neuerMonat()

  Dim lngRowSource  As Long
  Dim lngRowTarget  As Long

If ActiveSheet.Name = "Dienstplan" Then

   Worksheets("Dienstplan").Copy after:=Worksheets(Worksheets.Count)

   ActiveSheet.Name = "0" & Range("K3") + 1 & "." & Range("L3")
   ActiveSheet.Range("K3").Comment.Delete
   ActiveSheet.Range("K3").AddComment Text:="Es wurden bereits Monatsblätter angelegt!" & vbLf & "Bitte hier den Wert nicht ändern!" & vbLf & "Um weitere Monatsblätter zu erstellen, öffnen Sie das Monatsplatt mit dem letzten Monat."
   ActiveSheet.Range("K3").Comment.Shape.TextFrame.AutoSize = True
   
   Else
   
   ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
   Worksheets(Worksheets.Count).Name = Format(DateAdd("m", 1, "01." & Worksheets(Worksheets.Count - 1).Name), "mm.yyyy")
   
   End If
   
   'Zeilen einfügen
   
   'Hier wir die letzte Zeile der Spalte B ermittelt
   letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
   letztezeile = letztezeile - 4
   ' MsgBox letztezeile                   ActiveSheet.Range("W3") 'Anzahl der Mitarbeiter im TB "Mitarbeiter"
   
   If letztezeile < ActiveSheet.Range("W3") + 8 Then '9
   
   ActiveSheet.Range("B" & letztezeile).EntireRow.Insert
   
  'Hier wir die letzte Zeile der Spalte B (Bereich Mitarbeiter)im aktiven TB ermittelt
  letztezeile_neu = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row - 4
  'MsgBox letztezeile_neu
 
  'Kopieren und einfügen
  lngRowSource = letztezeile_neu
  lngRowTarget = letztezeile_neu - 1

  With ActiveSheet
    .Rows(lngRowSource).Cut
    .Rows(lngRowTarget).Insert Shift:=xlShiftDown
  End With
 
  'Text aus TB "Mitarbeiter" holen
  ActiveSheet.Range("B" & letztezeile_neu) = Worksheets("Mitarbeiter").Range("B" & letztezeile_neu - 1).Value
   
  End If
   
   'Ende einfügen
   
   'Monat auf Dez prüfen und neues Jahr anfangen
   If ActiveSheet.Range("K3") = 12 Then
   ActiveSheet.Range("K3") = 1
   ActiveSheet.Range("L3") = Range("L3") + 1
   Else
   ActiveSheet.Range("K3") = Range("K3") + 1
   End If
   
   'Tabelleninhalt leeren
   ActiveSheet.Range("C9:AG18").ClearContents
   
   'Blende alle Spalten ein
   Cells.EntireColumn.Hidden = False
   
   'Spalten ausblenden
   If ActiveSheet.Range("H3") < 31 Then
   ActiveSheet.Columns("AG:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 30 Then
   ActiveSheet.Columns("AF:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 29 Then
   ActiveSheet.Columns("AE:AG").EntireColumn.Hidden = True
   End If
   'Ende Spalten ausblenden

End Sub

[Andyle]

So, jetzt habe ich es mit einer Schleife umgesetzt. (Anfängerglück!)

Soweit funzt es auch alles.

Was mir allerdings nicht logisch erscheint ist:

Wird der Code einmal ausgeführt, funzt alles super.
Er erstellt das neue TB und trägt komplett alle Mitarbeiter aus TB "Mitarbeiter" ein.

der Code wird aus dem gerade erstellten TB wieder gestartet, dann schreibt er eventuell hinzugekommene Mitarbeiter darunter,
setzt jetzt allerdings als letzte eine leere Zeile darunter, wodurch dann dass nachholen von weiteren Mitarbeitern nicht so richtig funzt.

Was hab ich da falsch?

Code:

Sub neuerMonat()

  Dim lngRowSource  As Long
  Dim lngRowTarget  As Long

If ActiveSheet.Name = "Dienstplan" Then

   Worksheets("Dienstplan").Copy after:=Worksheets(Worksheets.Count)

   ActiveSheet.Name = "0" & Range("K3") + 1 & "." & Range("L3")
   ActiveSheet.Range("K3").Comment.Delete
   ActiveSheet.Range("K3").AddComment Text:="Es wurden bereits Monatsblätter angelegt!" & vbLf & "Bitte hier den Wert nicht ändern!" & vbLf & "Um weitere Monatsblätter zu erstellen, öffnen Sie das Monatsplatt mit dem letzten Monat."
   ActiveSheet.Range("K3").Comment.Shape.TextFrame.AutoSize = True
  
   Else
  
   ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
   Worksheets(Worksheets.Count).Name = Format(DateAdd("m", 1, "01." & Worksheets(Worksheets.Count - 1).Name), "mm.yyyy")
  
   End If
  
   'Hier wir die letzte Zeile der Spalte B ermittelt
   letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
   letztezeile = letztezeile - 4
  
  
   'Einfügen
  
   If letztezeile < ActiveSheet.Range("W3") + 8 Then
  
   '--------------------------------
   Dim r As Long
  
   bis = ActiveSheet.Range("W3") + 6
  
   For r = 9 To bis
   If letztezeile < ActiveSheet.Range("W3") + 8 Then
   letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
   letztezeile = letztezeile - 4
   'Zeile einfügen
   ActiveSheet.Range("B" & letztezeile).EntireRow.Insert
  
  'Hier wir die letzte Zeile der Spalte B (Bereich Mitarbeiter)im aktiven TB ermittelt
  letztezeile_neu = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row - 4
 
  'Kopieren und einfügen
  lngRowSource = letztezeile_neu
  lngRowTarget = letztezeile_neu - 1

  With ActiveSheet
    .Rows(lngRowSource).Cut
    .Rows(lngRowTarget).Insert Shift:=xlShiftDown
  End With
 
  'Text aus TB "Mitarbeiter" holen
  ActiveSheet.Range("B" & letztezeile_neu) = Worksheets("Mitarbeiter").Range("B" & letztezeile_neu - 1).Value
  End If
   Next r
   '--------------------------------
  
  
   End If
  
   'Ende einfügen
  
   '-------------------------------------------------------------------------------
  
   'Monat auf Dez prüfen und neues Jahr anfangen
   If ActiveSheet.Range("K3") = 12 Then
   ActiveSheet.Range("K3") = 1
   ActiveSheet.Range("L3") = Range("L3") + 1
   Else
   ActiveSheet.Range("K3") = Range("K3") + 1
   End If
  
   'Tabelleninhalt leeren
   letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
   letztezeile = letztezeile - 4
   ActiveSheet.Range("C9:AG" & letztezeile).ClearContents
  
   'Blende alle Spalten ein
   Cells.EntireColumn.Hidden = False
  
   'Spalten ausblenden
   If ActiveSheet.Range("H3") < 31 Then
   ActiveSheet.Columns("AG:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 30 Then
   ActiveSheet.Columns("AF:AG").EntireColumn.Hidden = True
   End If
   If ActiveSheet.Range("H3") < 29 Then
   ActiveSheet.Columns("AE:AG").EntireColumn.Hidden = True
   End If
   'Ende Spalten ausblenden

End Sub