Zeile kopieren wenn zelle
Michael
der damliger Beitrag ist schon geschlossen. War ein paar Tage krank und konnte nicht antworten.
Bitte nochmal um Hilfe.
Die Tabelle besteht aus den Spalten A bis AB. In der Spalte G steht entweder ein Name oder mit ; und Leerzeichen getrennt mehrere Namen nach dem Muster Familienname Leerzeichen Vorname.
Nun sollen alle Zeilen mit mehreren Namen in Spalte G sooft untereinamder kopiert werden als Namen in Spalte G stehen. Dabei sollen dann in den Zellen G nur mehr die einzelnen Namen stehen.
Nun müsste ich von der Duplizierung allerdings ein paar Zellen ausnehmen da es sonst bei Zeiten und Preisen zu Fehlberechnungen kommt. Die Zellen sind z.B. E, J, K usw.
Bin zwar kein VBA Star kann aber durchaus Anpassungen und Erwiterungen vornehmen wenn ich den Code verstanden habe ;-)
Hier das Macro von Sepp, das mit trim super funktioniert.
-------------------------------------
Sub splitNames()
Dim vntValues As Variant, vntTmp As Variant, vntNew() As Variant
Dim lngIndex As Long, lngN As Long, lngC As Long, lngM As Long
With ActiveSheet
vntValues = .Range("A2:AB" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For lngIndex = 1 To UBound(vntValues, 1)
If InStr(1, vntValues(lngIndex, 9), "; ") = 0 Then
lngN = lngN + 1
Redim Preserve vntNew(1 To UBound(vntValues, 2), 1 To lngN)
For lngC = 1 To UBound(vntValues, 2)
vntNew(lngC, lngN) = vntValues(lngIndex, lngC)
Next
Else
vntTmp = Split(vntValues(lngIndex, 9), ";")
For lngM = 0 To UBound(vntTmp)
lngN = lngN + 1
Redim Preserve vntNew(1 To UBound(vntValues, 2), 1 To lngN)
For lngC = 1 To UBound(vntValues, 2)
vntNew(lngC, lngN) = IIf(lngC = 9, Trim$(vntTmp(lngM)), vntValues(lngIndex, lngC))
Next
Next
End If
Next
vntNew = Application.Transpose(vntNew)
.Range("A2").Resize(UBound(vntNew, 1), UBound(vntNew, 2)) = vntNew
End With
End Sub
-------------------------------------
Danke Euch für die Hilfe
Grüsse aus dem verschneiten Wien
Michael