ich habe eine Makrokombination, die Zellen vergleicht und in der Höhe angleicht.
Das funktioniert soweit auch, allerdings werden mehrere Spalten miteinander verglichen.
Sub Spalten_A_E_und_F_J_vergleichen_und_angleichen()
Dim Bereich1 As Range
Dim Bereich2 As Range
Dim Bereich3 As Range
Dim Zelle As Range
Set Bereich1 = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set Bereich2 = Range("F2:F" & Cells(Rows.Count, "F").End(xlUp).Row)
Call Ergänzen(Bereich1, Bereich2)
Call Ergänzen(Bereich2, Bereich1)
Set Bereich1 = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row)
Set Bereich2 = Range("F2:J" & Cells(Rows.Count, "F").End(xlUp).Row)
Bereich1.Sort key1:=Bereich1(1, 1), order1:=xlAscending, header:=xlNo
Bereich2.Sort key1:=Bereich2(1, 1), order1:=xlAscending, header:=xlNo
On Error GoTo ende
For Each Zelle In Union(Bereich1.Columns(2), Bereich2.Columns(2)).SpecialCells(xlCellTypeBlanks) _
Zelle.Offset(0, -1).ClearContents
Next
Set Bereich3 = Range("A2:J" & Cells(Rows.Count, "A").End(xlUp).Row)
Bereich3.Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ende:
Call Leerzellen_auffuellen
On Error GoTo 0
End Sub
Private Sub Ergänzen(rng1 As Range, rng2 As Range)
Dim Zelle As Range
For Each Zelle In rng2
If WorksheetFunction.CountIf(rng1.EntireColumn, Zelle.Value)
Sub Leerzellen_auffuellen()
Dim L As Long
Dim Bereich As Range
For L = 1 To 8000
If WorksheetFunction.CountIf(Range(Cells(L, 6), Cells(L, 8)), "") = 3 Then _
Range(Cells(L, 1), Cells(L, 2)).Copy Range(Cells(L, 6), Cells(L, 7))
Next
Range("A2").Select
End Sub
Für einen ähnlichen Zweck bräuchte ich ein ähnlich funktionierendes Makro, das allerdings nur die Spalte A (beginnend ab A2) und die Spalte F (beginnend mit F2) vergleicht.
Das Angleichen soll aber weiterhin im Bereich A bis E und von F bis J erfolgen.
Kann mir jemand das Makro entsprechend umschreiben?
Grüße
Burghard