AW: Spalte B
24.05.2013 10:04:07
Klaus
Hi Markus,
oder dieses Script nehmen:
Sub Dublikate()
'hier kannst du es auf deine Datei anpassen
Const RowFirst As Long = 4 'in Zeile 4 anfangen
Const ColNummer As Long = 2 'Nummern in Spalte B = 2
Const ColBeschreibung As Long = 3 'Beschreibung in Spalte C = 3
Const TabelleAlt As String = "Tabelle1" 'von hier
Const TabelleNeu As String = "Tabelle2" 'da hin
Const NeuColNummer As Long = 1 'Nummer in Spalte A schreiben
Const NeuColBeschreibung As Long = 2 'Beschr. in Spalte B schreiben
Dim RowLast As Long
Dim NeuRowFirst As Long
Dim Bereich As Range
NeuRowFirst = 2 'Ab Zeile 2 schreiben
With Sheets(TabelleAlt)
RowLast = .Cells(.Rows.Count, ColNummer).End(xlUp).Row
For Each Bereich In .Range(.Cells(RowFirst, ColNummer), .Cells(RowLast, ColNummer))
'Möglichkeit 1: alle Duplikate nach dem ersten drüben auflisten
'Möglichkeit 2: alle Duplikate inklusive des ersten auflisten
If WorksheetFunction.CountIf(.Range(.Cells(RowFirst, ColNummer), .Cells(Bereich.Row, _
ColNummer)), Bereich.Value) > 1 Then
'If WorksheetFunction.CountIf(.Range(.Cells(RowFirst, ColNummer), .Cells(RowLast, _
ColNummer)), Bereich.Value) > 1 Then
Sheets(TabelleNeu).Cells(NeuRowFirst, NeuColNummer).Value = Bereich.Value
Sheets(TabelleNeu).Cells(NeuRowFirst, NeuColBeschreibung).Value = .Cells(Bereich. _
Row, ColBeschreibung).Value
NeuRowFirst = NeuRowFirst + 1
End If
Next Bereich
End With
End Sub