Anzeige
Archiv - Navigation
384to388
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
384to388
384to388
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Code Anpassung

Code Anpassung
20.02.2004 16:19:11
Y. Housein
Hallo Leute,
welchen Code muss ich hinzufügen, wenn ich die noch Werte von anderen Tabellen kopieren möchte. Im moment wird nur die Tabelle "Journal" kopiert. Ich möchte folgende Tabellen noch hinzufügen: "Verkaufte Artikel", "Verkaufte Artikel-Normal".

Sub JournalSammeln()
'von Josef Ehrensberger
Dim wkbGes As Workbook  'Die Gesamt - Datei
Dim wksG As Worksheet
Dim wksD As Worksheet
Dim rngD As Range
Dim lngG As Long
Dim lngD As Long
Dim intC As Integer
'On Error GoTo ERRORH
Dim arFiles As Variant
Set wkbGes = Workbooks("Gesamt.xls")   'Name der Gesamtdatei
Set wksG = wkbGes.Sheets("Journal")    'Name des Tabellenblattes für Gesammt-Journal
Application.ScreenUpdating = False
arFiles = Array("Ansbach.xls", "Anschaffenburg.xls", "Augsburg.xls", "Coburg.xls", _
"Erlangen.xls", "Gingen.xls", "Heidenheim.xls", "Heilbronn.xls", _
"Ingolstadt.xls", "Kempten.xls", "München-01.xls", "München-02.xls", _
"Nürnberg-01.xls", "Nürnberg-02.xls", "Pforzheim Karlsruhe.xls", _
"Regensburg.xls", "Stuttgart.xls", "Ulm.xls", "Würzburg.xls")   'dieses Array beliebig mit den Dateinamen erweitern
For intC = LBound(arFiles) To UBound(arFiles)
Application.StatusBar = "Öffne Datei " & arFiles(intC) & " ! Bitte warten"
Workbooks.Open ("M:\Ismail\Touren\" & arFiles(intC))  'Datei aus Array öffnen
Set wksD = ActiveWorkbook.Sheets("Journal")  'Tabelle "Journal"
lngG = wksG.Range("A65536").End(xlUp).Row + 1   'erste freie Zelle in "Gesammt"
lngD = wksD.Range("A65536").End(xlUp).Row 'Grösse des Bereiches bestimmen
If lngD < 10 Then lngD = 10
Set rngD = wksD.Range("A10:Z" & lngD)
Application.StatusBar = "Kopiere Daten!  Bitte warten"
rngD.Copy wksG.Range("A" & lngG)  'Daten kopieren
Application.StatusBar = "Schliesse Datei " & intC & " !  Bitte warten"
Workbooks(arFiles(intC)).Close savechanges:=False 'Datei schliessen
'ActiveWorkbook.Close ("M:\Ismail\Touren\" & arFiles(intC))
Next
ERRORH:  'Fehlerbehandlung
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Danke für die Hilfe
Gruß
Yilmaz

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
noch offen
20.02.2004 19:42:43
ChrisL
Hi Yilmaz
Gut gemeinter Hinweis... mir geht es zu lange deinen Code zu dechiffrieren, vielleicht willst du deine Frage ausformulieren und eine Beispieldatei hochladen.
Gruss
Chris

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige