Problem mit vorhandenen Code, Zeile einfügen fehlt

[snoopatroopa]

Hallo zusammen,

Ich habe ein Problem mit meinem Code. Den Code habe ich aus einem anderen Projekt. Jetzt möchte ich ihn noch anpassen, bekomm das aber nicht so richtig hin.  :s

Erläuterung:
Ich habe zwei Tabellenblätter. Eins ist gefüllt mit Projektdaten. Das andere beinhaltet ein Terminplan.
Ich kopiere mir die Projektdaten aus dem ersten Tabellenblatt (Daten stehen von Links nach Rechts) und füge sie im TabellenKOPF des Terminplanes untereinander in Spalte A ein.
Das untereinander Einfügen funktioniert tadellos, allerdings wird nur der Inhalt eingefügt und es werden keine zusätzlichen Zeilen erstellt. 
Somit wird der Tabellenkopf auch nicht erweitert, sondern die Daten werden über die gesamte Tabelle in Spalte A "gebügelt".

Wie muss ich den Code ändern, dass der Tabellenkopf (Spalte A) gefüllt wird und die vorhandene Tabelle nach unten rutscht. 

Also so ähnlich wie: Rechtsklick - Zellen einfügen.

Ich komm einfach nicht weiter.
Danke für eure Hilfe.

Code:

Sub Schaltfläche2_Klicken()
Dim rng As Range, x As Long

With Sheets("Projektdaten")
  x = 2
  For Each rng In .Range("B6:B" & .Cells(.Rows.Count, "D").End(xlUp).Row) _
    .SpecialCells(xlCellTypeConstants)
    Set rng = Union(rng, rng.Offset(0, 2), rng.Offset(0, 3))
    rng.Copy
    Sheets("Terminplan").Cells(x, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
         x = x + 4
  Next
 End With
 
End Sub

[schauan]

Hallöchen,

erst mal nur ein Tipp. Ich habe hier mal schnell das Einfügen aufgezeichnet:

Code:

Sub Makro1()
'
' Makro1 Makro
'

'
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

Wenn Du z.B. nur in Spalte A oben eine Zelle einfügen willst, könnte das gekürzt zur Verwendung in Deinem Makro so gehen:

Code:

Range("A1").Insert Shift:=xlDown

[snoopatroopa]

Hällooo,

erstmal sorry für die späte Meldung. 

Danke dir erstmal, das hab ich auch schon ausprobiert und versucht das irgendwie reinzufummeln. Aber leider geht das überhaupt nicht. 

Ich muss ja irgendwie sagen das ich für jeden eingefügten Inhalt, jeweils eine Zeile einfügen soll. 


Ich komm grad einfach nicht auf die Lösung. Hab es schon mit

Code:

Sheets("Terminplan").Rows(x).insert

 
versucht, aber das funzt auch irgendwie nicht.


Zum Haare raufen!  :22:

[Kuwer]

Hallo,

Sub Schaltfläche2_Klicken()

Dim rng As Range, x As Long



With Sheets("Projektdaten")

 x = 2

 For Each rng In .Range("B6:B" & .Cells(.Rows.Count, "D").End(xlUp).Row) _

   .SpecialCells(xlCellTypeConstants)

   Set rng = Union(rng, rng.Offset(0, 2), rng.Offset(0, 3))

   Sheets("Terminplan").Rows(x).Resize(4).Insert

   rng.Copy

   Sheets("Terminplan").Cells(x, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

       False, Transpose:=True

        x = x + 4

 Next

End With

End Sub

Gruß Uwe

[snoopatroopa]

:19:

Wow super.

Danke dir