Office: (Office 2013) Variable Anzahl von Werten in eine Zelle schreiben

Hallo,
Ich möchte Werte aus verschiedenen Zellen in ein und dieselbe schreiben und dies abhängig davon. ob die Quellzellen gefüllt sind oder nicht. ich habe einen kleinen Code geschrieben, der auch funktioniert. da ich das ganze aber mehrfach (und für mehr optionale Quellzellen) brauche und alles gerne ein wenig schlanker machen würde, frage ich mich, ob das auch irgendwie automatisierbar wäre. (zum Beispiel mit einem loop oder einer For-Funktion)
Danke schon mal.

Code:

Private Sub CommandButton1_Click()
lz = Cells(25, 1).End(xlUp).Rows.Row ' Durchlauf aller Zellen von A25 aufwärts

For t = lz To 2 Step -1 'Zählung rückwärts bis Zeile 2

If Cells(t, 1).Value <> "" Then

TabDoku.Cells(t, 8).Value = TabDoku.Cells(t, 1).Value

If TabDoku.Cells.Range("B2").Value <> "" And TabDoku.Cells.Cells.Range("B3").Value = "" Then

TabDoku.Cells.Cells(t, 10).Value = TabDoku.Range("b2").Value & vbCrLf & vbCrLf

ElseIf TabDoku.Range("B2").Value <> "" And TabDoku.Cells.Range("B3").Value <> "" And TabDoku.Range("B4").Value = "" Then

TabDoku.Cells(t, 10).Value = TabDoku.Range("b2").Value & vbCrLf & TabDoku.Range("b3").Value & vbCrLf & vbCrLf

ElseIf TabDoku.Range("B2").Value <> "" And TabDoku.Cells.Range("B3").Value <> "" And TabDoku.Range("B4").Value <> "" And TabDoku.Range("B5").Value = "" Then

TabDoku.Cells(t, 10).Value = TabDoku.Range("b2").Value & vbCrLf & TabDoku.Range("b3").Value & vbCrLf & TabDoku.Range("b4").Value & vbCrLf & vbCrLf


ElseIf TabDoku.Cells.Range("B2").Value = "" Then
TabDoku.Cells(t, 10).Value = vbCrLf & vbCrLf


End If

End If

Next t
 
End Sub

 

Hallo dingsala,

probier doch mal so:

Code:

Private Sub Test()

Dim lz As Integer, t As Integer, Zeile As Integer, TabDoku As Worksheet
    
lz = Cells(25, 1).End(xlUp).Rows.Row ' Durchlauf aller Zellen von A25 aufwärts
Set TabDoku = ActiveSheet

For t = lz To 2 Step -1 'Zählung rückwärts bis Zeile 2

    If Cells(t, 1).Value <> "" Then
    
        TabDoku.Cells(t, 8).Value = TabDoku.Cells(t, 1).Value
        
        For Zeile = 2 To 4
            If TabDoku.Cells(Zeile, 2).Value <> "" Then
                TabDoku.Cells(t, 10).Value = TabDoku.Cells(t, 10) & TabDoku.Cells(Zeile, 2).Value & vbCrLf
            Else
                Exit For
            End If
        Next Zeile
        TabDoku.Cells(t, 10).Value = TabDoku.Cells(t, 10) & vbCrLf
  
    End If

Next t
 
End Sub

Was du mit
lz = Cells(25, 1).End(xlUp).Rows.Row ' Durchlauf aller Zellen von A25 aufwärts
machen willst, ist mir allerdings etwas schleierhaft.
Zum Ermitteln der letzten verwendeten Zeile schau mal hier:
Letzte Zeile, letzte Spalte und letzte Zelle per VBA ermitteln - Excel-Inside Solutions

Gruß,
Lutz