Gruppe
Allgemein
Bereich
Bearbeiten
Thema
Spalten mit gleichen Spaltenköpfen zusammenfassen
Problem
Spalten mit gleichen Kopfzeilen sollen zusammengefaßt werden.
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: Modul1
Sub Zusammenfassen()
Dim iRow As Integer, iCol As Integer, iAct As Integer
Dim iCountC As Integer, iRowLT As Integer, iRowLS As Integer
iCol = 1
Do Until IsEmpty(Cells(1, iCol))
For iAct = iCol + 1 To WorksheetFunction.CountA(Rows(1))
If Cells(1, iCol).Value = Cells(1, iAct).Value And _
WorksheetFunction.CountA(Columns(iCol)) > 1 Then
iRowLS = Cells(Rows.Count, iAct).End(xlUp).Row
iRowLT = Cells(Rows.Count, iCol).End(xlUp).Row + 1
Range(Cells(2, iAct), Cells(iRowLS, iAct)).Cut _
Cells(iRowLT, iCol)
End If
Next iAct
iCol = iCol + 1
Loop
Application.CutCopyMode = False
For iCol = Range("IV1").End(xlToLeft).Column To 1 Step -1
If WorksheetFunction.CountA(Columns(iCol)) = 1 Then
Columns(iCol).Delete
End If
Next iCol
End Sub