Ich hätte gerne ein Makro, das eine bestimmte Spalte in ein anderes Tabellenblatt kopiert und danach alle doppelten Einträge löscht.
(damit ich die neue Liste als Filterkriterium benutzen kann)
Besten Dank für Eure Hilfe.
Private Sub Workbook_Open()
Dim wks As Worksheet
Dim liZeile As Integer
Dim liInhalt As Integer, liDoppelt As Integer, lboDoppelt As Boolean
Dim liEintrag As Integer
'für "Tabelle1" musst Du den Tabellenblattnamen angeben, um den es hier geht
Set wks = Worksheets("Tabelle1")
'ab hier wird die Anzahl der eingetragenen Regionen ermittelt
liZeile = 11
Do Until wks.Range("C" & liZeile).Value = ""
liZeile = liZeile + 1
Loop
ReDim lstrInhalt(liZeile - 11) As String
'ab hier werden doppelte Einträge von Regionen ausgefiltert
liZeile = 11
Do Until wks.Range("C" & liZeile).Value = ""
For liDoppelt = 0 To liInhalt
If lstrInhalt(liDoppelt) = wks.Range("C" & liZeile).Value Then
lboDoppelt = True
Exit For
End If
Next
If lboDoppelt = False Then
lstrInhalt(liInhalt) = wks.Range("C" & liZeile).Value
liInhalt = liInhalt + 1
Else
lboDoppelt = False
End If
liZeile = liZeile + 1
Loop
'ab hier werden die jetzt nur noch 1x vorkommenden Regionen in die Combobox eingetragen
Sheets("Tabelle1").ComboBox1.Clear
For liEintrag = 0 To liInhalt - 1
Sheets("Tabelle1").ComboBox1.AddItem lstrInhalt(liEintrag)
Next
End Sub
Sub KopiereSpalte()
Dim laR As Long, i As Long
With Worksheets("Tabelle1")
laR = .Cells(Rows.Count, 3).End(xlUp).Row
Worksheets("Tabelle2").Range("A11:A" & laR).Value = _
.Range("C11:C" & laR).Value
End With
With Worksheets("Tabelle2")
.Range("A1:A" & laR).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
laR = .Cells(Rows.Count, 1).End(xlUp).Row
For i = laR To 2 Step -1
If .Cells(i, 1).Value = .Cells(i - 1, 1).Value Then .Rows(i).Delete Shift:=xlUp
Next i
End With
End Sub