Datensätze (per VBA?) auswerten

Hallo Excelprofis,
ich hoffe wieder einmal auf eure Hilfe.
Ich möchte einzelne Datensätze aus der Tabelle "Daten" in eine andere Tabelle ("Daten1") übertragen (kopieren).
Die Daten der Quelldatei ("Daten") befinden sich im Bereich A5:J421. Allerdings stehen in sämtlichen Zellen dieses Bereichs Formelbezüge, aufgrund derer in diesen Zellen entweder ein Wert (Text oder Zahl) oder "" eingetragen ist. Die Feldbezeichungen befinden sich in der Zeile 4 (A4:J4).
Ich möchte nun (einzelne Felder) der Datensätze, bei denen in der Spalte J der Tabelle "Daten" (J5:J421) ein "x" eingetragen ist, in die Tabelle "Daten1" übertragen. Diese ist bereits in der Datei vorhanden. Die - zu übertragenden Datensätze - sollten (zeilenweise) in der Zieltabelle ("Daten1") ebenfalls ab Zeile 5 eingetragen werden. Da ich in der Zieltabelle nicht alle Datenfelder benötige, ergibt sich bezüglich der Datenfelder (Spalten der jeweiligen Tabelle) folgende Zuordnung:
Quelltabelle:B - Zieltabelle:B
Quelltabelle:C - Zieltabelle:C
Quelltabelle:E - Zieltabelle:D
Quelltabelle:G - Zieltabelle:E
Quelltabelle:H - Zieltabelle:F
Quelltabelle:I - Zieltabelle:G
Der Code sollte so konzipiert sein, dass die Daten der Zieltabelle ("Daten1")im Bereich B5:G421 zunächst jeweils gelöscht werden, damit ich bei Änderungen der Daten in der Quelltabelle die Zieltabelle jeweils aktualisieren kann.
Für jede Hilfe bereits jetzt besten Dank!
Gruß
Fritz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Fritz!
Sollte klappen:

Sub Daten_Uebertragen()
Dim quelle As Worksheet
Dim ziel As Worksheet
Dim rng As Range
Dim lRow As Long
Dim lastRow As Long
Set quelle = Sheets("Daten")
Set ziel = Sheets("Daten1")
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
lastRow = 5
ziel.Range(" B5:G421").ClearContents
With quelle
For lRow = 5 To 421
If LCase(.Cells(lRow, 10)) = "x" Then
Set rng = Union(.Cells(lRow, 2), .Cells(lRow, 3), .Cells(lRow, 5), _
.Cells(lRow, 7), .Cells(lRow, 8), .Cells(lRow, 9))
rng.Copy
ziel.Cells(lastRow, 2).PasteSpecial xlPasteValues
lastRow = lastRow + 1
End If
Next
End With
With Application
.CutCopyMode = False
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Gruß Sepp

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread