AW: Daten in andere Datei üebrtragen-Netzlaufwerk
25.05.2009 20:06:06
fcs
Hallo Andreas,
zu Frage 1:
wenn die Reihenfolge der Tabellenblattregister in Original- und Zielmappe identisch ist dann kannst du mit den Nummer arbeiten. Es empfiehlt sich aber meistens, wenn die Namen in beiden Mappen vorkommen, die Tabellen des Originals nach den Nummern abzuarbeiten und als Zieltabelle die Tabelle in der Zielmappe mit dem gleichen Namen festzulegen.
zu Frage 2:
Ob eine Lösung eleganter ist hängt ja davon ab wie du vorgehen möchtest und was du erreichen willst. Manchmal will man die Datendateien ja auch Makrofrei halten, dann muss man die Makros extern speichern.
Du kannst das Makro auch in der Ziel- oder Originaldatei speichern. Dann muss die Objektvariable wbZiel bzw. wbOrig anders gesetzt werden.
Beispiel bei speichern des Makros in Zieldatei:
Set wbZiel = ThisWorkbook
statt
Set wbZiel = Workbooks.Open(Filename:="C:\Lokale Daten\Test\Mappe1.xls")
Frage 3:
Mehrere Tabellenblätter kannst du in einer Schleife abarbeiten.
Abhängig von der Nummer oder dem Namen des Tabellenblatts setzt du dann auch die Zeile in der die absoluten Adressen stehen.
Gruß
Franz
Beispiel mit Abarbeiten in Schleife
Sub DatenausOriginalHolen3()
Dim wbOrig As Workbook, wbZiel As Workbook
Dim wksOrig As Worksheet, wksZiel As Worksheet
Dim SpalteZiel As Long, SpalteOrig As Long
Dim ZeileKey As Long, intI As Long
Set wbZiel = Workbooks.Open(Filename:="C:\Lokale Daten\Test\Mappe1.xls")
Set wbOrig = Workbooks.Open(Filename:="C:\Lokale Daten\Test\Original.xls", _
ReadOnly:=True)
For intI = 1 To wbOrig.Worksheets.Count
Set wksOrig = wbOrig.Worksheets(intI)
Select Case wksOrig.Name 'Abfrage über Namen der Tabelle
' Select Case wksOrig.Index 'Abfrage über Index-Nummer der Tabelle
Case "Tabelle1" 'name ggf. anpassen
' Case 1 'Nummer ggf. anpassen
ZeileKey = 1
Case Else
ZeileKey = 3
End Select
Set wksZiel = wbZiel.Worksheets(wksOrig.Name)
'Daten im Zielblatt unterhalb Keyzeile löschen
With wksZiel
If .Cells.SpecialCells(xlCellTypeLastCell).Row > ZeileKey Then
.Range(.Rows(ZeileKey + 1), .Rows(.Cells.SpecialCells(xlCellTypeLastCell).Row)). _
ClearContents
End If
End With
'daten Kopieren
For SpalteZiel = 1 To wksZiel.Cells(ZeileKey, wksZiel.Columns.Count).End(xlToLeft).Column
For SpalteOrig = 1 To wksOrig.Cells(ZeileKey, wksOrig.Columns.Count).End(xlToLeft).Column
If wksZiel.Cells(ZeileKey, SpalteZiel).Value = wksOrig.Cells(ZeileKey, SpalteOrig). _
Value Then
With wksOrig
.Range(.Cells(1, SpalteOrig), .Cells(.Rows.Count, SpalteOrig)).Copy _
Destination:=wksZiel.Cells(1, SpalteZiel)
End With
End If
Next
Next
Next intI
'originaldatei wieder schliessen
wbOrig.Close savechanges:=False
End Sub