Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 17:40:39
16.10.2025 17:25:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeile kopieren falls bestimmte Zelle >0

Forumthread: Zeile kopieren falls bestimmte Zelle >0

Zeile kopieren falls bestimmte Zelle >0
09.06.2006 22:28:47
Alex
Hallo Forum,
hab eine Frage und hoffe Ihr könnt mir helfen.
In Spalte A stehen Artikelnummern die selbe Artikelnummer kann in der Spalte A auch mehmals stehen.
In Spalte B steht die Anzahl der Artikelnummern (1-100).
Hier ein Beispiel:
A / B
12AAA / 3
12AAA / 1
16BBB / 1
16BBB / 1
16BBB / 1
Ist nun der Wert einer Zelle in der Spalte B grösser als 1 so soll unter der jeweiligen Zeile diese Zelle Kopiert werden und zwar so oft wie der Anzahl in spalte B. (in einem neuen worksheet)
Stelle mir das so vor:
A / B
12AAA / 1
12AAA / 1
12AAA / 1
12AAA / 1
16BBB / 1
16BBB / 1
16BBB / 1
Es wäre schön wenn mir jemand helfen könnte.
Danke
Gruß
Alex
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: Zeile kopieren falls bestimmte Zelle >0
09.06.2006 23:32:23
Josef
Hallo Alex!
Ich nehme an, daß die Daten ab Zeile 2 stehen.
Sub kopiereZeilen()
Dim objSh As Worksheet
Dim varA As Variant, varB As Variant, varC() As Variant
Dim lngRow As Long, lngLast As Long, lngIndex As Long
Dim intC As Integer


lngLast = Cells(Rows.Count, 1).End(xlUp).Row

If lngLast < 2 Then lngLast = 2

varA = Range("A2:A" & lngLast)
varB = Range("B2:B" & lngLast)

Redim varC(1 To Application.Sum(varB), 1 To 2)

On Error Resume Next

If IsArray(varA) Then
  For lngRow = 1 To UBound(varA, 1)
    For intC = 1 To varB(lngRow, 1)
      lngIndex = lngIndex + 1
      varC(lngIndex, 1) = varA(lngRow, 1)
      varC(lngIndex, 2) = 1
    Next
  Next
Else
  For intC = 1 To UBound(varC, 1)
    varC(intC, 1) = varA
    varC(intC, 2) = 1
  Next
End If

On Error GoTo 0

Set objSh = Sheets.Add(after:=ActiveSheet)

With objSh
  .Name = Format(Now, "ddmmyy_hhmmss")
  .Range("A2:B" & UBound(varC, 1) + 1) = varC
End With

Set objSh = Nothing

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Zeile kopieren falls bestimmte Zelle >0
10.06.2006 14:06:38
Alex
Hallo Sepp,
das ist super und funktioniert genau so wie ich es wollte.
DANKE DIR VIELMALS!!!!
Gruß
Alex
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige