Anpassungsproblem Quellen + Ziel
02.12.2008 09:51:47
Andreas
bei meinem Problem geht es darum viele Arbeitsblätter aus mehreren Mappen nach einem bestimmten Muster in vier Tabellen zu kopieren.
Die Quellmappen sind leider tierisch kopliziert aufgebaut (und nicht von mir) und müssen zur Auswertung zumsammenkopiert werden (von mir). Die Beispieldatei enthält zur Veranschaulichung zwei von diesen Quell-Arbeitsblättern und als Beispiel ein Zielblatt. Insgesamt geht es um 11 Quellmappen mit jeweils 29 Arbeitsblättern, von denen ich immer Blatt 2 bis 28 brauche. Die Zieldatei soll 4 Blätter für die Ausgangsorte Nürnberg, Augsburg, Passau, Salzburg enthalten in die die Daten aus den Quellmappen rein sollen.
Zur Kopiergeschichte habe ich schon die Schleifen geschrieben, ich habe nur ein Problem damit die QuellMappen und Zielmappen zu definieren. Die Quellmappen werden alle im gleichen Verzeichnis liegen und einen identischen Stamm "DL_Name" haben.
Wenn mir dazu jemand einen Tipp geben könnte wäre ich sehr dankbar.
--------------------------------------------------------------------------------------------------------------------------
Sub TabelleNürnberg()
'Makro am 27.11.2008 von b9119 aufgezeichnet
Dim QuellZeile As Integer, ZielZeile As Integer
Dim letzteZeile As Integer
Dim QuellTabelle As Workbook, i As Integer
Dim ZielTabelle As Workbook, j As Integer
Dim ClusterZähler As Integer
Dim Verzeichnis As String
Set ZielTabelle = ActiveWorkbook.Worksheets(1) 'Makro muss aus Quellmappe aufgerufen _
werden!!
Verzeichnis = "C:\Documents and Settings\b9119\Desktop\Auswertungstool\"
QuellTabelle = Workbooks.Open("C:\Documents and Settings\b9119\Desktop\Auswertungstool" & "\ _
" & ".xls")
'27 Arbeitsblätter (Blätter 2-28) pro Mappe auslesen
ZielZeile = Worksheets("Ankara").Range("a65536").End(xlUp).Row + 1
Debug.Print ZielZeile
Do Until QuellTabelle = ActiveWorkbook.Worksheets(28)
QuellZeile = 8
letzteZeile = ActiveSheet.Cells(250, 1).End(xlUp).Row
Debug.Print letzteZeile
Do Until QuellZeile = letzteZeile
Debug.Print ZielZeile
ClusterZähler = 6
Do Until ClusterZähler > 15
Windows("Gesamt_Test.xls").Activate
Cells(ZielZeile, 1).Select
QuellTabelle.Activate 'kopiert Spalten A bis E (erste Spalten _
für jede Zeile nötig)
Range(Cells(QuellZeile, 1), Cells(QuellZeile, 5)).Select
Selection.Copy
Windows("Gesamt_Test.xls").Activate
ActiveSheet.Paste
Cells(ZielZeile, ClusterZähler).Select 'fügt die Preise, Zeiten, KM-Stände ü _
ber die Cluster ein
QuellTabelle.Activate
Range(Cells(QuellZeile, ClusterZähler), Cells(QuellZeile, ClusterZähler + 2)). _
Select
Application.CutCopyMode = False
Selection.Copy
Windows("Gesamt_Test.xls").Activate
ActiveSheet.Paste
Cells(ZielZeile, 9).Select 'das ist die Zelle, für das Längencluster
QuellTabelle.Activate
Range(Cells(6, ClusterZähler), Cells(6, ClusterZähler + 2)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Gesamt_Test.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Cells(ZielZeile, 10).Select
QuellTabelle.Activate 'kopiert den Dateinamen(=Name Dienstleister _
aus "A1") in die 10. Spalte
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Gesamt_Test.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
ClusterZähler = ClusterZähler + 3
ZielZeile = ZielZeile + 1
Loop
QuellZeile = QuellZeile + 1
Debug.Print QuellZeile
Loop
QuellTabelle = ActiveWorkbook.Worksheets(i + 1)
Loop
End Sub
--------------------------------------------------------------------------------------------------------------------------------
Vielen Grüße!
Andreas