Werte übertragen

Hallo zusammen,
ich habe einen Code verfasst, der Werte aus einem Sheet in ein zweites übertragen soll. Es funktioniert jedoch nur eingeschränkt. Nach dem zweiten Übertrag überschreibt er die zuletzt übernommenen Werte im zweiten Sheet, anstelle die nächste leere Zeile zu wählen. Ich nehme stark an, dass es an der If Verzweigung liegt. Kann mir evtl. jemand weiterhelfen?
Vielen Dank!
Grüße Felix

Sub Daten_ablegen()
Dim Kunde As String, GrossesUN_kurz As String, GrossesUN_mittel As String, GrossesUN_lang As  _
String, Sparte_kurz As String, Sparte_mittel As String, _
Sparte_lang As String, Vertrieb_kurz As String, Vertrieb_mittel As String, Vertrieb_lang As  _
String, Produkt_kurz As String, Produkt_mittel As String, _
Produkt_lang As String, Werkstoff_kurz As String, Werkstoff_mittel As String, Werkstoff_lang As  _
String, Ausrichtung21 As Long, _
Ausrichtung22 As Long, Ausrichtung25 As Long
Worksheets("Kundenanalyse").Select
Kunde = Range("B2")
GrossesUN_kurz = Range("H11")
GrossesUN_mittel = Range("L11")
GrossesUN_lang = Range("P11")
Sparte_kurz = Range("H12")
Sparte_mittel = Range("L12")
Sparte_lang = Range("P12")
Vertrieb_kurz = Range("H13")
Vertrieb_mittel = Range("L13")
Vertrieb_lang = Range("P13")
Produkt_kurz = Range("H14")
Produkt_mittel = Range("L14")
Produkt_lang = Range("P14")
Werkstoff_kurz = Range("H15")
Werkstoff_mittel = Range("L15")
Werkstoff_lang = Range("P15")
Ausrichtung21 = Range("N4")
Ausrichtung22 = Range("O4")
Ausrichtung25 = Range("P4")
Worksheets("Ausrichtung (2)").Select
Worksheets("Ausrichtung (2)").Range("A2").Select
If Worksheets("Ausrichtung (2)").Range("A2").Offset(1, 0)  "" Then
Worksheets("Ausrichtung (2)").Range("A2").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Kunde
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = GrossesUN_kurz
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = GrossesUN_mittel
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = GrossesUN_lang
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sparte_kurz
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sparte_mittel
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sparte_lang
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vertrieb_kurz
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vertrieb_mittel
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vertrieb_lang
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Produkt_kurz
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Produkt_mittel
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Produkt_lang
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Werkstoff_kurz
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Werkstoff_mittel
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Werkstoff_lang
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Ausrichtung21
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Ausrichtung22
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Ausrichtung25
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Daten_ablegen() Dim iCount, arrAdr, iRowInput% arrAdr = Array("H11", "L11", "P11", "H12", "L12", "P12", "H13", "L13", "P13", "H14", "L14", " _ P14", "H15", "L15", "P15", "N4", "O4", "P4") With Sheets("Ausrichtung (2)") If .Range("A3") "" Then iRowInput = .Cells(Rows.Count, 1).End(xlUp).Row + 2 Else iRowInput = 3 End If .Cells(iRowInput, 1).Value = Range("B2").Value '* Kunde For iCount = 1 To 18 .Cells(iCount + iRowInput, 1).Value = Range(arrAdr(iCount)).Value Next iCount End With End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread