Office: (Office 365) Per VBA Zeilen einfügen und danach in diese Texte kopieren

Hallo zusammen,

ich möchte im 1. Schritt via VBA-Code eine bestimmte, variable Anzahl Zeilen (der Wert wird immer im Reiter "Data" in der Zelle S32 ermittelt) in einem anderen Reiter namens "Angebot" immer ab der Zeile 29 hinzufügen.

Im 2. Schritt sollen aus dem Zeilen-Block S2:S30 des Reiters "Data" nun nur die Inhalte der Zeilen die einen Inhalt haben in den zuvor geschaffenen Bereich im Reiter "Angebot" kopiert werden.

Wie müsste der VBA-Code dafür lauten ?

DANKE für Deine Antwort im Voraus.
Jens

 

Moin,

in VBA wären dazu keine zwei Schritte notwendig. Das ginge in einer Schleife.

Grüße

 

Das hatte ich schon geahnt, nur eben keine konkrete Vorstellung wie man das umsetzt.

 

Wie ich den 1. Teil lösen sollte ist mir schleierhaft und hoffe daher auf Deine Hilfe.
Der 2. Teil müsste dann zumindest wie folgt funktionieren:

Sub Makro1() ' Angebotsgrundlagen kopieren
Sheets("Data").Range("S2").Select
Sheets("Data").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Angebot").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

 

Ich hab gerade noch mal was probiert und bekomme nun die gewünschte Anzahl Zeilen in dem anderen Reiter eingefügt, jedoch wird der Text nicht in die neuen Zeilen kopiert.
Was passt jetzt noch nicht ?

Sub Makro1() ' Angebotsgrundlagen auswählen und kopieren

Dim Zeilenanzahl As Integer
Zeilenanzahl = Sheets("Data").Range("S32")
Sheets("Angebot").Select
Rows("29:29").Select
Range(ActiveCell, ActiveCell.Offset((Zeilenanzahl - 1), 0)).EntireRow.Insert
Cancel = True

Sheets("Data").Range("S2").Select
Sheets("Data").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Angebot").Select
Range("A29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

 

Mit dem folgenden Code hat es nun geklappt.
Ich benötige jedoch noch eine Ergänzung. Und zwar müssen die jeweilig eingefügte Zeilen von Spalte A bis E verbunden und linksbündig ausgerichtet werden ... also jede Zeile für sich. Da wüsste ich nun gar nicht wie man das mit einem Schleifen-Code machen sollte.

Ausgangslage hierfür ist die zu editierende Anzahl Zeilen: Zeilenanzahl = Sheets("Data").Range("S32")
sowie der Startpunkt (die Startzeile) ab dem die Zeilen verbunden und ausgerichtet werden sollen: Range("A29").Select

Sub Makro1() ' Angebotsgrundlagen auswählen und kopieren

Dim Zeilenanzahl As Integer
Zeilenanzahl = Sheets("Data").Range("S32")
Sheets("Angebot").Select
Rows("29:29").Select
Range(ActiveCell, ActiveCell.Offset((Zeilenanzahl - 1), 0)).EntireRow.Insert
Cancel = True

Sheets("Data").Select
Sheets("Data").Range("S2").Select
Sheets("Data").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Angebot").Select
Range("A29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

 

Hallo zusammen, kann mir vielleicht bitte noch jemand bzgl. der Ergänzung helfen ?
Danke dafür im Voraus.

 

Moin,

mit dem Makrorecorder kannst Du Dir den Code für das Verbinden von Zellen (iggittipfuispeib!) besorgen. Der wird natürlich auch wieder mit Selection daherkommen, die man in VBA so gut wie nie wirklich braucht.

Und Schleifen hast Du doch schon gebastelt. Wo ist das Problem?

Grüße

 

Ich hab da was gefunden und angepasst, doch funktioniert es leider noch nicht.

Sheets("Angebot").Range("A1:E1") = hier habe ich den Bereich (A1:E1) als Kopiervorlage bereits verbunden und formatiert
Sheets("Data").Range("S32") = hier steht die Anzahl der Zeilen die eingefügt werden soll
Sheets("Angebot").Range(A29) = ab dieser Zeile/Zelle soll die von oben kopierte Zelle gemäß der Anzahl x mal und immer wieder darunter eingefügt werden.


Dim iRow As Long, i As Integer
Sheets("Angebot").Range("A1:E1").Select.CurrentRegion.Copy
With Sheets("Data")
For i = 1 To Sheets("Data").Range("S32")
iRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 2
.Range("A29" & iRow).PasteSpecial
Next i
End With

 

irow ist 100
Du möchteste es also in A29100 kopieren.
ich vermute
.Range("A29").Offset(Irow, 0)

 

Hallo lieber Hajo,

wenn ich nicht falsch liege benötige ich das "iRow" doch gar nicht, oder ?
Jedoch hängt sich der Code beim Ausführen in der rot formatierten Zeile auf --> "Objekt erforderlich"

Dim i As Integer
Sheets("Angebot").Range("A1:E1").Select.CurrentRegion.Copy
With Sheets("Data")
For i = 1 To Sheets("Data").Range("S32")
.Range ("A29")
Next i
End With

 

ich hätte
Sheets("Angebot").Range("A1:E1").Copy
geschrieben.

Gruß Hajo

 

Ich hab es mal wie folgt geändert, nun bleibt es da hängen

Dim i As Integer
Sheets("Angebot").Range("A1").Select
Sheets("Angebot").Range("A1").Copy
With Sheets("Data")
For i = 1 To Sheets("Data").Range("S32")
.Range ("A29")
Next i
End With

 

ja da fehlt die Aktion.
Sheets("Data").Range("S32") ist 1000
warum 1000 mal die Aktion in der gleichen Zelle.

Gruß Hajo

 

Ich kann leider nicht sagen warum das 1.000 ist.

In Zelle Sheets("Data").Range("S32") steht bei mir eine "5".