Bestimmte Anzahl an Zellen hinzufügen

[DeLaGhetto]

Hallo zusammen,

folgendes Problem:

Ich habe verschiedene Datensätze, die im Reiter "Woche 1" stehen. Diese Datenstätze fangen in Zelle A7 an und gehen bis A310.
Jetzt kann es vorkommen, dass ich aus bestimmten Gründen die Zellen 1 und/oder 2 und/oder 3 komplett löschen muss. Somit beginnen meine Datensätze nicht mehr in Zelle A7 sondern dann eben in A6, oder A5 oder A4.

Gibt es einen Code, der überprüft, ob vor der Zelle A7 noch 6 andere Zellen vorhanden sind? Falls dies nicht der Fall sein sollte, dann fügt das Makro eine bestimmt Anzahl an Spalten hinzu, sodass meine Datensätze wieder in Zelle A7 anfangen?
Oder von mir aus ein Makro, das den kompletten Datensatz aus zum Beispiel A4 auf A7 verschiebt?

Zur Info (Falls das hillfreich ist):
Die Zellen 1-6 sind komplett leer, das heißt erst in Zelle A7 gibt es einen Text.

Hoffe ihr könnt mir da weiterhelfen...

[fkw48]

dann fügt das Makro eine bestimmt Anzahl an Spalten hinzu ? - oder Zeilen ?
sodass meine Datensätze wieder in Zelle A7 anfangen - ergo sollen "oben" immer 7 freie Zeilen ?

Code:

Sub SiebenZwerge()
'Zur Info (Falls das hillfreich ist):
'Die Zellen 1-6 sind komplett leer, das heißt erst in Zelle A7 gibt es einen Text
Dim rngA
  With Sheets("Woche 1").Columns("A")
     On Error GoTo errh
     Do While .ColumnDifferences(.Cells(.Cells.Count)).Cells(1).Row < 7
        .Rows(1).Insert
     Loop
     Do While .ColumnDifferences(.Cells(.Cells.Count)).Cells(1).Row > 7
        .Rows(1).Delete
     Loop
  End With
errh:
End Sub

[fkw48]

PS - "oben" immer 6 freie Zeilen ?

[DeLaGhetto]

Super, funktioniert perfekt. Danke

Wobei, mir ist noch eine Frage eingefallen:
Wie müsste ich den Code ändern, wenn ich das gleiche, für mehrere Reiter haben möchte? (Woche 1, Woche 2, Woche 3, Woche 4, Woche 5)?
Wenn du mir hier noch helfen könntest, wäre es sehr nett

[fkw48]

Code:

Option Explicit

Sub SiebenZwerge()
  'prüfe wo
  AlleSiebenZwerge "Woche 1 Woche 3"
  'prüfe nicht
  KeineSiebenZwerge "Tabelle2 Woche 2"
End Sub

Sub AlleSiebenZwerge(Tabellen As String)
Dim Sh As Worksheet
  For Each Sh In Sheets
     If InStr(Tabellen, Sh.Name) Then
        With Sh.Columns("A")
           On Error GoTo errh
           Do While .ColumnDifferences(.Cells(.Cells.Count)).Cells(1).Row < 7
              .Rows(1).Insert
           Loop
           Do While .ColumnDifferences(.Cells(.Cells.Count)).Cells(1).Row > 7
              .Rows(1).Delete
           Loop
        End With
     End If
  Next Sh
errh:
End Sub

Sub KeineSiebenZwerge(Tabellen As String)
Dim Sh As Worksheet
  For Each Sh In Sheets
     If InStr(Tabellen, Sh.Name) Then
     Else
        With Sh.Columns("A")
           On Error GoTo errh
           Do While .ColumnDifferences(.Cells(.Cells.Count)).Cells(1).Row < 7
              .Rows(1).Insert
           Loop
           Do While .ColumnDifferences(.Cells(.Cells.Count)).Cells(1).Row > 7
              .Rows(1).Delete
           Loop
        End With
     End If
  Next Sh
errh:
End Sub

[img]
Dateiupload bitte im Forum! So geht es: Klick mich!
]

[DeLaGhetto]

Merci