Zeile nach bestimmten Wert einer Zelle kopieren
#1
Hallo zusammen,

ich stehe wie der Ochs vor dem Berg. Ich habe eine Tabelle mit einem Wert in bzw. ab A2, nun möchte ich in einem neuen Tabellenblatt die Zeile nach dem Wert einfügen, sprich steht da 3 möchte ich auf dem neuen Tabellenblatt die komplette Zeile 3 mal kopiert haben und dann zur nächsten Zeile. Ich bekomme jedoch einen Laufzeitfehler 13 bei "For i..." Gehe ich das ganze falsch an?

Code:
Option Explicit



Public Sub Einf_nach_Menge()
Sheets("HilfstabelleKopieren").Select
Dim aktZeile As Long
Dim aktZielZeile As Long
Dim i, Zeilen
'Set akt_Anzahl = Sheets("HilfstabelleKopieren").Range("A2")
aktZielZeile = 2
With Sheets("HilfstabelleKopieren")
    .Rows(1).Copy Sheets("HilfstabelleÜbertragung").Rows(1)
    Zeilen = .Range("A" & .Rows.Count).End(xlUp).Row
    For aktZeile = 2 To Zeilen
    '.Range("D" & .Rows).End(xlUp).Row
        For i = 1 To .Range("A" & aktZeile)
            .Rows(aktZeile).Copy Sheets("HilfstabelleÜbertragung").Rows(aktZielZeile)
            aktZielZeile = aktZielZeile + 1
        Next i
    Next aktZeile
End With

End Sub
Antworten Top
#2
Hallo

prüfe bitte einmal diese Zeile:   mit Range(A & aktZeile) holst du einen Wert aus dieser Zelle, was ist wenn da Text drin steht?

Code:
For i = 1 To .Range("A" & aktZeile)   ändere es bitte mal in:   For i = 1 To aktZeile

mfg Gast 123
Antworten Top
#3
Danke, das behebt zwar den Laufzeitfehler, jedoch kopiert er die letzte Zeile bis zum Abbruch durch mich. Die Schleife findet quasi kein Ende
Antworten Top
#4
Hi,

dein Code läuft bei mir sauber durch solange in A2:Ax nur positive Zahlen stehen.

Wenn das nicht sicher gestellt ist, dann musst du vor deiner i-Schleife Prüfen, ob in A eine Zahl größer 0 steht:
Code:
For aktZeile = 2 To Zeilen
    If IsNumeric(.Range("A" & aktZeile)) Then
        If .Range("A" & aktZeile) > 0 Then
            For i = 1 To .Range("A" & aktZeile)
                'Dein Code
            Next i
        End If
    End If
Next aktZeile

Übrigens könntest du dir die i-Schleife komplett sparen:
Code:
For aktZeile = 2 To Zeilen
    With .Range("A" & aktZeile)
        If IsNumeric(.Value) Then
            If .Value > 0  And CInt(.Value) = .Value Then
                .EntireRow.Copy Sheets("HilfstabelleÜbertragung").Rows(aktZielZeile).Resize(.Value)
                aktZielZeile = aktZielZeile + .Value
            End If
        End If
    End With
Next aktZeile
Gruß,
Helmut

Win10 - Office365 / MacOS - Office365
Antworten Top
#5
Das hört sich doch schon einmal gut an, vielen Dank werde ich nachher gleich mal testen

Hab jetzt ne Abfrage eingebaut, manchmal steht man halt wirklich auf dem Schlauch.... Mein Code schaut wie folgt aus uns läuft :)

Code:
Option Explicit



Public Sub Einf_nach_Menge()
Sheets("HilfstabelleKopieren").Select
Dim aktZeile As Long
Dim aktZielZeile As Long
Dim i, Zeilen
'Set akt_Anzahl = Sheets("HilfstabelleKopieren").Range("A2")
aktZielZeile = 2
With Sheets("HilfstabelleKopieren")
    .Rows(1).Copy Sheets("HilfstabelleTEST").Rows(1)
    Zeilen = .Range("A" & .Rows.Count).End(xlUp).Row
    For aktZeile = 2 To Zeilen
    If .Range("A" & aktZeile) <> "" Then
    '.Range("D" & .Rows).End(xlUp).Row
        For i = 1 To .Range("A" & aktZeile)
            .Rows(aktZeile).Copy Sheets("HilfstabelleTEST").Rows(aktZielZeile)
            aktZielZeile = aktZielZeile + 1
        Next i
    End If
    Next aktZeile
End With

End Sub
Antworten Top


Gehe zu:


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