Problem mit vorhandenen Code, Zeile einfügen fehlt
#1
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


Angehängte Dateien
.xlsm   terminplan ausfüllen.xlsm (Größe: 27,42 KB / Downloads: 4)
Top
#2
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
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top
#3
Hällooo,

erstmal sorry für die späte Meldung.  Blush

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:
Top
#4
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
Top
#5
:19:

Wow super.

Danke dir
Top


Gehe zu:


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