AW: Werte von einem Tab in einer anderen Mappe bri
07.06.2006 23:53:00
einem
Hallo Peter,
in Excel geht vieles, wenn es um die systematische Behandlung von Daten in Tabellen geht.
In nachfolgendem Makro muss du natürlich die Datei- und Tabellennamen noch anpassen.
mfg Franz
Sub Filterübertragen()
' Überträgt gefilterte Daten aus Quelltabelle in Zieltabelle mit anderem Spaltenaufbau
' Voraussetzung für korrekte Funktion: In Spalte A müssen in beiden Tabellen alle Zeile ausgefüllt sein!!
Dim wbQuelle As Workbook, wbZiel As Workbook, wksQuelle As Worksheet, wksZiel As Worksheet
Dim rngQuelle As Range, ZeileZ As Long, ZeileQ As Long, Titel() As Integer, Bereich As Range
Dim J As Integer, I As Integer
Set wbQuelle = Workbooks("PetersQuelle.xls") ' Arbeitsmappe mit den gefilterten Quelldaten
Set wksQuelle = wbQuelle.Sheets("Tab1") 'Tabelle mit gefilterten Quelldaten
With wksQuelle
' gefilterte Daten mit Überschrift ab Zeile 7
Set rngQuelle = .Range(.Cells(7, "A"), .Cells(.Cells(65000, "A").End(xlUp).Row, "X"))
End With
Set wbZiel = Workbooks("PetersZiel.xls") ' Arbeitsmappe mit den Ziedaten
Set wksZiel = wbZiel.Sheets("Tab1") ' Tabelle mit Zieldaten
ZeileZ = wksZiel.Cells(65000, "A").End(xlUp).Row + 1 'Nächste leere Zeile in Zieltabelle
'Spaltentitel zuordnen durch Überschriftvergkeich
ReDim Titel(1 To rngQuelle.Columns.Count, 1 To 2)
For I = 1 To rngQuelle.Columns.Count
Titel(I, 1) = I 'Spaltennummer in Quelltabelle
For Each Bereich In wksZiel.Range(wksZiel.Cells(1, "A"), wksZiel.Cells(1, "AH"))
If rngQuelle(1, I) = Bereich.Value Then
Titel(I, 2) = Bereich.Column 'zugehörige Spaltennummer in Zieltabelle
End If
Next Bereich
Next I
'Daten übertragen
For I = 2 To rngQuelle.Rows.Count
ZeileQ = rngQuelle.Row + I - 1
If rngQuelle.Rows(I).Hidden = False Then
For J = 1 To rngQuelle.Columns.Count
If Titel(J, 2) <> 0 Then
wksZiel.Cells(ZeileZ, Titel(J, 2)).Value = wksQuelle.Cells(ZeileQ, Titel(J, 1)).Value
End If
Next J
ZeileZ = ZeileZ + 1
End If
Next I
MsgBox ("Datenübertragung abgeschlossen")
End Sub