Frage zu Excelmakro, Zellen zusammenfügen und kopieren

Hallo zusammen

Gerne möchte ich folgende Makro aus diesem Forum nützen, jedoch sollten leere Zellen ignoriert werden, Am besten wäre, wenn eine Endzelle gesetz werden kann. Ebenfalls sollten die Daten nicht im gleichen Tabellenblatt ausgegegebn werden.
Könnt Ihr mir dabei helfen?

Option Explicit

Const StartZeile = 2


Sub FillColumnC_Value()
    Dim Cell As Range

    With Columns("C:C")  
        .NumberFormat = "@"                                                                                  'Text-Format in Spalte C  
        .HorizontalAlignment = xlRight                                                                      'Ausrichtung Rechts  
    End With

    For Each Cell In Range("A:A")  
        If Cell.Row >= StartZeile Then                                                                        'Ab Startzeile  
            If IsEmpty(Cell) Then Exit Sub                                                                       'Bis zur 1. Leerzeile  
                
            With Cell.Offset(0, 2)
                .Value = Cell.Text & Chr(10) & Cell.Offset(0, 1).Text                            'Spalte C = Spalte A & Spalte B  
                .Characters(Len(Cell.Text) + 1, -1).Font.Italic = True                           'Wert aus Spalte B werden kursiv  
            End With
        End If
    Next
  End Sub

Danke für eure Hilfe.

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 184714

Url: https://administrator.de/forum/frage-zu-excelmakro-zellen-zusammenfuegen-und-kopieren-184714.html

Ausgedruckt am: 21.04.2025 um 18:04 Uhr

2 Kommentare

Neuester Kommentar

Moin urs2012,

in starker Anlehnung an obigen Code, etwa so:

Sub FillColumnC_Value()
    Const StartZeile As Long = 2
    Const EndZeile As Long = 200
    Dim z As Long                                           ' Zeilenindex  
    With ThisWorkbook.Sheets(2).Columns("C:C")              ' Zieltabelle  
        .NumberFormat = "@"                                 ' Text-Format in Spalte C  
        .HorizontalAlignment = xlRight                      ' Ausrichtung rechts  
    End With
    With ThisWorkbook.Sheets(1)                             ' Quelltabelle  
        For z = StartZeile To EndZeile
'            If IsEmpty(.Cells(z, 1)) Then Exit Sub                          ' 1. Leerzelle (nur A)  
            If IsEmpty(.Range(.Cells(z, 1), .Cells(z, 2))) Then Exit Sub    ' 1. Leerzeile (A & B)  
            Sheets(2).Cells(z, 3) = .Cells(z, 1) & Chr(10) & .Cells(z, 3)   ' C = A & vbCr & B  
            Sheets(2).Cells(z, 3).Characters(Len(.Cells(z, 3).Text) + 1, -1).Font.Italic = True ' Werte aus B kursiv  
        Next z
    End With
End Sub