Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
216to220
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
216to220
216to220
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

kleine Frage

kleine Frage
13.02.2003 14:58:03
jani
Hallo,

ich habe mal eine Frage, ob was möglich ist? da ich nicht so den durchblick mit VB habe, möchte ich die frage hie rmal stellen.

Ich habe 1500 exel dateien, die im Bereich A4-23/I4-23 komplett abgedeckt sind mit daten. Diese sollen alle in eine neue Vorlage kopiert werden ( vorlage.xls ) wo nur oben der "kopf" ein anderes Design hat. Meine Frage ist nun, ist es möglich die Dateien in die Vorlage kopieren zu lassen, ohne jede einzelne datei zu öffnen und per Hand zu kopieren ? Wenn ja wie ? kann mir dort jemand weiterhelfen ?

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: kleine Frage
13.02.2003 15:02:26
Steffen D

Hallo jani,

mit VBA geht das, allerdings kommst du um das öffnen der 1500 dateien nicht drum rum.
du musst sie alle nacheinander öffnen, auslesen und wieder schließen...
wie heißen die Dateien?
Wenn die namen der Dateien alle gleich aufgebaut sind, dann könnte man das ganze in einer schleife machen, wenn nicht dann musst du davor entweder einen Array oder eine Tabelle mit den Pfaden der Dateien füllen.

Gruß
Steffen D

Re: kleine Frage
13.02.2003 15:07:35
jani

hallo,

ja sie heissen alle gleich, ausser die endung ist anders. also Sie beginnen mit samstagsverlosung001.xls und enden bei samstagsverlosung1465.xls ! ist das so möglich ? ist mir egal wenn ich nicht bei öffnen drum herum komme, ich will die nur nicht alle einzelt kopieren udn einfügen. kannst du mir helfen ?

Anzeige
Re: kleine Frage
13.02.2003 15:07:35
jani

hallo,

ja sie heissen alle gleich, ausser die endung ist anders. also Sie beginnen mit samstagsverlosung001.xls und enden bei samstagsverlosung1465.xls ! ist das so möglich ? ist mir egal wenn ich nicht bei öffnen drum herum komme, ich will die nur nicht alle einzelt kopieren udn einfügen. kannst du mir helfen ?

kleine Frage zurück
13.02.2003 17:12:36
Panicman

Hallo Jani,

habe ich das richtig verstanden das du 1500 mal DATEN (also keine Formeln oder Formate) für den Bereich A4:I23 in EINE (1) Vorlage haben möchtest ? Also ca. 30.000 Zeilen in EINER DATEI ?

oder verstehe ich den Problem immer noch nicht ?

Gruß
Holger

Anzeige
Re: kleine Frage zurück
13.02.2003 18:04:26
jani

ja genau so, oder in eine datenbank, also access übertragen ! geht das ? bzw wie ?

Re: kleine Frage
13.02.2003 21:56:38
Steffen D

Hallo jani,

also, deine xls-Dateien müssen alle in einem Ordner sein! (z.b. C:\temp\...)

erstelle einfach eine neue mappe und füge dieses makro in ein Modul ein und führe es aus:

For i=1 To 1465
Workbooks.Open "C:\temp\samstagsverlosung" & format(i, "000") & ".xls"
Range("A4:I23").Copy
with ThisWorkbook.Sheets("Tabelle1")
.Range("A" & .Range("A65536").End(xlUp).Row).pastespecial
activeworkbook.close false
next i

das wird aber wahrscheinlich nicht ganz perfekt laufen,
ich habs nicht getestet, habe einfach so aus dem Gedächtnis geschrieben...

vielleicht kann ich dir morgen dann weiterhelfen...

Gruß und Gute Nacht
Steffen D

Anzeige
Re: kleine Frage
13.02.2003 21:56:39
Steffen D

Hallo jani,

also, deine xls-Dateien müssen alle in einem Ordner sein! (z.b. C:\temp\...)

erstelle einfach eine neue mappe und füge dieses makro in ein Modul ein und führe es aus:

For i=1 To 1465
Workbooks.Open "C:\temp\samstagsverlosung" & format(i, "000") & ".xls"
Range("A4:I23").Copy
with ThisWorkbook.Sheets("Tabelle1")
.Range("A" & .Range("A65536").End(xlUp).Row).pastespecial
activeworkbook.close false
next i

das wird aber wahrscheinlich nicht ganz perfekt laufen,
ich habs nicht getestet, habe einfach so aus dem Gedächtnis geschrieben...

vielleicht kann ich dir morgen dann weiterhelfen...

Gruß und Gute Nacht
Steffen D

Anzeige
Korrektur
13.02.2003 21:57:28
Steffen D

Hi,

ich habe ein end with vergessen:

For i=1 To 1465
Workbooks.Open "C:\temp\samstagsverlosung" & format(i, "000") & ".xls"
Range("A4:I23").Copy
with ThisWorkbook.Sheets("Tabelle1")
.Range("A" & .Range("A65536").End(xlUp).Row).pastespecial
end with
activeworkbook.close false
next i


Re: kleine Frage
13.02.2003 23:07:45
Panicman

Hallo Jani,

hab etwas länger gebraucht. Ich hoffe es funzt.
Wird aber bestimmt lange dauern.
Es sollten in dem Verzeichnis nur die benötigten Dateien stehen.


Sub Uebernahme_Jani()
'Es sollen von ca. 1.500 Dateien die Werte des Bereichs A4:I23 in eine Datei (Vorlage.xls)
'untereinander kopiert werden. Wird sehr lange dauern

Dim I As Integer, IRow As Integer           'Counter
Dim Pfad As String, DATmPF As String        'Pfad
Dim DAT As String, DAT1 As String           'Dateinamen
Dim Zelle As String                         '
Dim Anz As Integer                          'Anzahl der Dateien
Dim Zahl As Byte
On Error GoTo ErrorHandler

Application.ScreenUpdating = False          'Schaltet Bildschirmupdate ab
Application.DisplayAlerts = False           'Schaltet die Warnmeldungen aus
IRow = 4

Pfadangabe:
Pfad = InputBox("Bitte den Pfad mit Laufwerksbuchstaben angeben: ", "Pfad")
If Mid(Pfad, 2, 2) <> ":\" Then
    MsgBox ("Haben Sie vielleicht den Laufwerksbuchstaben vergessen ?")
    GoTo Pfadangabe
End If

Anzahldateien:
Anz = InputBox("Bitte geben Sie die Anzahl der Dateien ein," & Chr(10) & _
               "die verarbeitet werden sollen", "Anzahl Dateien")
If Anz > 100 Then
    MsgBox ("Das könnte ziemlich lange dauern bei über 100 Dateien !!!")
End If

Dateiangabe:
DAT = InputBox("Bitte geben Sie den 1. Dateinamen ein: ", "Dateiname")
If Right(DAT, 4) = ".xls" Then
    DAT = Left(DAT, Len(DAT) - 4)
End If
On Error GoTo ErrorEndung
    Zahl = Right(DAT, 3) * 1
    I = Right(DAT, 3)

DAT = Left(DAT, Len(DAT) - 3)
Range("B4").Select

For I = 1 To Anz
    On Error GoTo ErrorHandler
    DATmPF = Pfad & "\" & DAT & Format(I, "#000") & ".xls"
    Zelle = Cells(IRow, 2).Address
    Range(Zelle).Select
    
    'Arbeitsmappe öffnen
    ChDir Pfad
    Workbooks.Open Filename:=DATmPF
    
    Range("B4:I23").Select
    Selection.Copy
    
    Workbooks("vorlage.xls").Worksheets("Tabelle1").Activate
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    
    'Arbeitsmappe schließen
    DAT1 = DAT & Format(I, "#000") & ".xls"
    Workbooks(DAT1).Close saveChanges = False
    
    IRow = IRow + 20
Next
    Application.ScreenUpdating = True          'Schaltet Bildschirmupdate ab
    Application.DisplayAlerts = True           'Schaltet die Warnmeldungen wieder ein
    Exit Sub

ErrorEndung:
MsgBox ("sollten die letzten 3 Zeichen nicht Zahlen sein ?")
GoTo Dateiangabe

ErrorHandler:
MsgBox ("Es ist ein Fehler aufgetreten." & Chr(10) & _
        Chr(10) & "mögliche Fehler konnen sein:" & Chr(10) & _
        "1.) Es sind weniger Dateien vorhanden als bei Anzahl angegeben" & Chr(10) & _
        "2.) Die Dateien sind nicht fortlaufend, bzw. vielleicht fehlen welche" & Chr(10) & _
        Chr(10) & "Das Programm wird nun beendet !!!")

End Sub
 

     Code eingefügt mit Syntaxhighlighter 1.15

Gruß
Holger

Anzeige
Re: Korrektur
14.02.2003 09:44:33
jani

dank dir steffen,

leider kommt bei dir auch ein fehler und zwar beim kompilieren der "ausserhalb einer prozedur umgültig"
und bezwieht sich auf For i=1 To 1465

vielleicht weisst du den fehler ?


mfg

Re: kleine Frage
14.02.2003 09:44:45
jani

hi panicman,

danke für deine mühe, wiess ich zu schätzen, jedoch kommt bei mri ein fehler. ich gebe als pfad halt c:\temp\ an. dann gebe ich die anzahl der dateien an, wenn ich dieses gemacht habe fragt er ja nach der 1. datei. da gebe ich dann samstagsverlosung001 an ohne .xls ? ist doch richtig oder ? dann kommt ein fehler. warum weiss ich auch nicht... er heißt " überlauf " :(

Anzeige
Re: Korrektur
14.02.2003 10:22:23
Steffen D

Hallo

du musst den Code natürlich in eine Funktion (Sub) packen:

Sub Makro()
For i = 1 To 1465
Workbooks.Open "C:\temp\samstagsverlosung" & Format(i, "000") & ".xls"
Range("A4:I23").Copy
With ThisWorkbook.Sheets("Tabelle1")
.Range("A" & .Range("A65536").End(xlUp).Row).PasteSpecial Paste:=xlValues
End With
ActiveWorkbook.Close False
Next i
End Sub


Gruß
Steffen

Re: kleine Frage
14.02.2003 10:39:22
Panicman

Hallo Jani,

habe mir 1500 Dateien estellt und immer den Bereich A4:I23 in eine Datei Vorlage kopieren lassen. Kann den Fehler nicht reproduzieren.
Kann es sein, das du mehr als 1500 Dateien genommen hast ?
oder mehr als 20 Zeilen pro Tabelle aussuchst ?
Einen "Überlauf" bekommt man, wenn die Anzahl der Zeilen in einer Tabelle zu wenig ist oder eine variable zu gering dimensioniert ist. Bei zuviel Zeilen kann ich nichts machen.
Aber änder mal die Zeile
Dim I As Integer, IRow As Integer 'Counter
in
Dim I As Integer, IRow As Long 'Counter
Vielleicht hilfs

Gruß
Holger

Anzeige
Re: kleine Frage
14.02.2003 11:09:19
jani

DANKE DANKE ! ;)

ich habs hin bekommen, ich danke euch beiden für dei nette und fixe antwort....

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige