Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1236to1240
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
Inhaltsverzeichnis

Filtern und in Tabelle2 schreiben

Filtern und in Tabelle2 schreiben
Carmen
Hallo,
in der Tabelle1 stehen ca 2000 Datensätze (Spalten A bis M).
Diese Daten sollen in Tabelle2 geschrieben werden, sofern ...
Aus der Tabelle 1 ( Spalte B ) sollen die Daten mit Tabelle3 (Filter) verglichen werden (Filter = Spalte A, ca 20 Datensätze).
Wenn der Filter aus Tabelle3 (Filter) mit Spalte (B) aus Tabelle1 übereinstimmt, sollen die Daten nicht nach Tabelle2 übertragen werden. Alle anderen Datensätze von Tabelle1 nach Tabelle2 schreiben.
In allen 3 Tabellen sind die Überschriften in Zeile1 und müssen nicht verglichen, bzw. geschrieben werden.
Vielen Dank für eine Hilfe.
Carmen

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Filtern und in Tabelle2 schreiben
03.11.2011 10:21:15
fcs
Hallo Carmen,
mit dem folgenden Makro sollte es funktionieren.
Die Namen der Tabellen muss du ggf. anpassen.
Gruß
Franz

Sub DatenUebertragen()
Dim wksData As Worksheet
Dim wksFilter As Worksheet
Dim wksZiel As Worksheet
Dim rngFilter As Range, rngFinden As Range
Dim lngZeile_D As Long
Dim lngZeile_Z As Long
Dim boolCopy As Boolean
Set wksFilter = Worksheets("Tabelle3")  'Tabellenblatt mit den Filter-Daten
Set wksData = Worksheets("Tabelle1")    'Tabellenblatt mit den Ausgangsdaten
Set wksZiel = Worksheets("Tabelle2")    'Tabellenblatt in das die Daten kopiert werden sollen
With wksFilter
'Bereich mit den zu vergleichenden Daten im Filter in Spalte A (1)
Set rngFilter = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
With wksZiel
'Letzte Zeile mit Daten in Spalte B
lngZeile_Z = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
With wksData
For lngZeile_D = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
'Wert in Spalte B im Filterdatenbereich suchen
Set rngFinden = rngFilter.Find(What:=.Cells(lngZeile_D, 2).Value, _
LookIn:=xlValues, lookat:=xlWhole)
boolCopy = False
If rngFinden Is Nothing Then
'Eintrag in Blatt mit Filter nicht vorhanden
boolCopy = True
Else
'Eintrag in Blatt mit Filter nicht sichtbar
If rngFinden.EntireRow.Hidden = True Then boolCopy = True
End If
If boolCopy = True Then
lngZeile_Z = lngZeile_Z + 1
.Rows(lngZeile_D).Copy Destination:=wksZiel.Rows(lngZeile_Z)
End If
Next lngZeile_D
End With
MsgBox "Fertig mit Übertragen der Daten"
End Sub

Anzeige

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige