Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
344to348
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
344to348
344to348
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kopieren ohne Doppelte (Zeile)

Kopieren ohne Doppelte (Zeile)
28.11.2003 12:15:00
Erich M.
Hallo zusammen,

habe aus dem Forum nachstehendes Makro, das die Spalte A in
eine neue Tabelle kopiert, ohne "doppelte Werte" in Spalte A.
Ich bräuchte die Lösung in der form, dass nicht nur die Spalte,
sondern die Spalten A - P kopiert werden. Es sollen aber nur die
Zeilen nicht kopiert werden, wenn in Spalte A doppelte Werte sind.
Doppelte Werte in den anderen Spalten sind unerheblich:

'https://www.herber.de/forum/archiv/340to344/t343949.htm
' kopieren Spalte A ohne Doppelte

Sub AKopierenOhneDoppelte()
Dim wks As Worksheet
Dim iRow As Integer, iRowT As Integer
Set wks = Worksheets("Doppelte")
wks.Columns("A").ClearContents
iRowT = 0
For iRow = 1 To Range("A65536").End(xlUp).Row
If Cells(iRow, 1) <> "" Then
If WorksheetFunction.CountIf(wks.Columns(1), _
Cells(iRow, 1)) = 0 Then
iRowT = iRowT + 1
wks.Cells(iRowT, 1) = Cells(iRow, 1)   ' Original
'            wks.Rows.Cells(iRowT) = Rows.Cells(iRow)  ' geht nicht
'            wks.Rows.Cells(iRowT) = Rows.Cells(iRowT) ' geht nicht
End If
End If
Next
End Sub


Besten Dank für eine Hilfe!

mfg
Erich

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren ohne Doppelte (Zeile)
28.11.2003 13:29:02
PeterW
Hallo Erich,

probier es mal so:

Sub AKopierenOhneDoppelte()
Dim wks As Worksheet
Dim iRow As Integer, iRowT As Integer
Set wks = Worksheets("Doppelte")
wks.Columns("A").ClearContents
iRowT = 0
For iRow = 1 To Range("A65536").End(xlUp).Row
If Cells(iRow, 1) <> "" Then
If WorksheetFunction.CountIf(wks.Columns(1), _
Cells(iRow, 1)) = 0 Then
iRowT = iRowT + 1
Range(Cells(iRow, 1), Cells(iRow, 16)).Copy wks.Cells(iRowT, 1)
End If
End If
Next
End Sub

Gruß
Peter
Danke - Peter! perfekt - o.T.
28.11.2003 16:10:24
Erich M.
.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige