Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1296to1300
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
Inhaltsverzeichnis

Laufzeitfehler 13

Laufzeitfehler 13
12.02.2013 14:39:26
Stephan
Hallo.
Ich hab eine Mastertabelle erstellt in diese sollen verschiede Informationen aus web optimierten *.HTML Dateien einfließen (wie zB. Ort, PLZ ....)
Ich habe nun die erste Datei genommen und per Aufzeichnung eingefügt funktioniert alles super und sieht so aus
Sub Einlesen()
' Einlesen Makro
ChDir "D:\Abraham\Projekte\Frühförderung\Rohdaten\pages"
Workbooks.Open Filename:= _
"D:\Abraham\Projekte\Frühförderung\Rohdaten\pages\7.html"
Range("B4:C4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Windows("7.html").Activate
Cells.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Range("B4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
Windows("7.html").Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("C3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Windows("7.html").Activate
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("D3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("E4").Select
Application.CutCopyMode = False
Selection.Copy
Range("E5").Select
Windows("Datenbank2.xlsm").Activate
Range("E3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("F3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("G3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("H3").Select
ActiveSheet.Paste
Range("I3").Select
Windows("7.html").Activate
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
Windows("7.html").Activate
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("J3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("K3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("L3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("M3").Select
ActiveSheet.Paste
Windows("7.html").Activate
ActiveWindow.Close savechanges:=False
End Sub

nun kommt das komplexere in dem Ordner Pages sind 1206 Datensätze die ich so per Schleife einbinden will.
Diese Daten hab ich per FSO in List1 gesammelt und will sie nun per FOR NEXT Schleife einbauen.
Sah dann erstmal so aus
Public oFSO As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File
Dim List1 As New Collection
Sub Einlesen()
Dim i As Integer
Dim dummy As String
' Einlesen Makro
Set oFolder = oFSO.GetFolder("D:\Abraham\Projekte\Frühförderung\Rohdaten\pages\")
For Each oFile In oFolder.Files
List1.Add oFile
Next
For i = 1 To List1.Count
ChDir "D:\Abraham\Projekte\Frühförderung\Rohdaten\pages\"
Workbooks.Open Filename:=List1(i)
Range("B4:C4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Windows(List1(i)).Activate
Cells.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Range("B4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("C3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Windows(List1(i)).Activate
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("D3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("E4").Select
Application.CutCopyMode = False
Selection.Copy
Range("E5").Select
Windows("Datenbank2.xlsm").Activate
Range("E3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("F3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("G3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("H3").Select
ActiveSheet.Paste
Range("I3").Select
Windows(List1(i)).Activate
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("J3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("K3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("L3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("M3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
ActiveWindow.Close savechanges:=False
Next
End Sub

nun sehe ich noch das die erste Datei die aufgemacht wird 10.html ist aber ersagt dann auch gleich oben Laufzeitfehler 13.
Per Dummy - String (den man oben noch etwas sieht) konnte ich sehen das der Pfad der richtige ist und 10.html öffnet sich auch also wo ist nun das Problem? denn bis zum Kopieren kommt er nicht

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Laufzeitfehler 13
12.02.2013 17:00:13
Stephan
So ich hab noch was verändert was wohl anfangs ein Problem war.
Ich hab die 2 Zeilen auskommentiert und dann läuft es bis zur fett markierten Zeile.
Also die 10.html kopiert ihr erstes Feld korrekt in die Dantenbank2.xlsm und läuft dann für das nächste feld in den Laufzeitfehler 13 warum entzieht sich mir allerdings wieder.
    ChDir "D:\Abraham\Projekte\Frühförderung\Rohdaten\pages\"
Workbooks.Open Filename:=List1(i)
Range("B4:C4").Select
Selection.Copy
' Windows("Datenbank2.xlsm").Activate
' Windows(List1(i)).Activate
Cells.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Range("B4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
  Windows(List1(i)).Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
hat da jemand eine Idee zu?

Anzeige
AW: Laufzeitfehler 13
12.02.2013 17:12:17
Sheldon
Hallo Stephan,
das sieht aber alles ziemlich wüst aus... Na wenns denn funktioniert, schön. Jedenfalls klappt das mit dem Öffnen der Dateien im Ordner nicht so recht, weil die Definition deiner Variablen irgendwie seltsam anmutet.
Die grundsätzliche Idee, alle Dateinamen in einem Array zu speichern und dann der Reihe nach aufzurufen, ist nett, aber unnötig und außerdem für meinen Geschmack zu kompliziert zu realisieren. Der ganze Schritt ist auch nicht nötig, denn Du hast ja bereits eine For Each..Next-Schleife gebaut, um den Array zu befüllen - darin kannst Du genauso gut auch die Verarbeitung der Datei einbauen!
Ich schlage mal den folgenden Code vor, testen musst Du natürlich selbst, das kann ich nicht, denn ich habe keine Deiner Dateien als Beispiel zur Verfügung und auch keine "Datenbank2.xlsm".
Sub Einlesen()
Dim oFSO As Variant
Dim oFolder As Variant
Dim oFile As Variant
Dim oWB As Variant
Const Workpath As String = "D:\Abraham\Projekte\Frühförderung\Rohdaten\pages\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(Workpath)
For Each oFile In oFolder.Files
Set oWB = Workbooks.Open(Filename:=oFile)
Range("B4:C4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
oWB.Activate
Cells.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Range("B4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
oWB.Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
oWB.Activate
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("C3").Select
ActiveSheet.Paste
oWB.Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
oWB.Activate
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("D3").Select
ActiveSheet.Paste
oWB.Activate
Range("E4").Select
Application.CutCopyMode = False
Selection.Copy
Range("E5").Select
Windows("Datenbank2.xlsm").Activate
Range("E3").Select
ActiveSheet.Paste
oWB.Activate
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("F3").Select
ActiveSheet.Paste
oWB.Activate
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("G3").Select
ActiveSheet.Paste
oWB.Activate
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("H3").Select
ActiveSheet.Paste
Range("I3").Select
oWB.Activate
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
oWB.Activate
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("J3").Select
ActiveSheet.Paste
oWB.Activate
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("K3").Select
ActiveSheet.Paste
oWB.Activate
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("L3").Select
ActiveSheet.Paste
oWB.Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("M3").Select
ActiveSheet.Paste
oWB.Activate
ActiveWindow.Close savechanges:=False
Next
End Sub

Wie Du siehst, habe ich alle Variablen als Variant deklariert und innerhalb des Subs, nichts außerhalb. Mir erschloss sich der Sinn nicht, warum Du einige Variablen global definiert hast. Außerdem habe ich ein oFSO mit der Funktion CreateObject als Scripting.FilesystemObject definiert. Mag sein, dass man da auch irgendeinen Verweis setzen kann und so die Typen FileSystemObject, File und Folder direkt als Variablentypen nutzen kann, aber einen solchen Verweis hab ich nicht gesetzt und arbeite daher immer auf die hier angewandte Weise damit - und es funktioniert ohne Fehlermeldung ;-)
Als letzten, kleinen Wink in die richtige Richtung solltest Du verstehen, wie ich mit der Variable oWB jeweils die aktuell geöffnete Datei direkt in eine Objektvariable speichere. Somit brauche ich nicht mit Dateinamen zu jonglieren, sondern kann immer direkt das Dateiobjekt ansprechen. So funktioniert das übrigens bestens mit allen Objekten. Auf diese Weise könntest Du auch auf sämtliche .Activate, .Select, etc. Befehle verzichten, die macht der Makrorecorder zwar, aber eleganter und auch kürzer und übersichtlicher wird der Code ohne sie.
Gruß
Sheldon

Anzeige
AW: Laufzeitfehler 13
12.02.2013 18:29:33
Stephan
Hi erstmal vielen Dank!
Den dummy string hab ich wieder rausgenommen.
Also läuft tatsächlich problemlos alle Dateien durch und macht auch seine Arbeit(dauert bei 1206 Dateien etwas aber das nehm ich gerne in kauf) bis auf einen entscheidenen Punkt
es schreibt alles in die Spalten A3 - M3 und überschreibt diese quasi immer wieder aber das muss ja Datei für Datei runter ruschten (also der nächste durchlauf dann B3 - M3 dann C3 - M3 usw.)
Soweit ich weis müsste das ja das doch dann über nen UsedRang.count = UsedRang.count + 1 machen oder?
und wenn an welcher stelle müsste ich das einbauen? immer vor das Selection.Copy? oder geht das auch eleganter?
Oder kann man da im With Selection schon einfach sagen nicht überschreiben und es wird dadurch zwangsweise schon immer eine Spalte tiefer eingefügt?

Anzeige
AW: Laufzeitfehler 13
12.02.2013 21:33:20
Sheldon
Hi Stephan,
ja, da hast Du recht. So stehts in Deinem Code. Immer da, wo die Datenbank2.xlsm aktiviert wird (also Windows("Datenbank2.xlsm").Activate steht), findest Du 1-3 Zeilen darunter einen Befehl wie z.B. Range("B3").Select, gefolgt von ActiveSheet.Paste.
Den Rangebefehl musst Du nun ändern, und zwar in z.B. Range("B3").End(xlDown).Offset(1, 0).Select
Wobei der fettgedruckte Teil darüber entscheidet, ob in Spalte B, C usw. geschrieben wird, also entsprechend beachten und eintragen!
Das machst Du nun mit jedem der Befehle unterhalb von Windows("Datenbank2.xlsm").Activate, aber nicht unterhalb von oWB.Activate. Dann sollte es so funktionieren wie Du es haben willst.
Gruß
Sheldon

Anzeige
testen...
12.02.2013 21:36:44
Sheldon
Hi nochmals,
für einen Testlauf würde ich Dir davon abraten, alle tausendplusx Dateien durchrattern zu lassen. Kopier Dir einfach mal zwei oder drei davon in ein neu angelegtes Verzeichnis und schreib dann das in die WorkPath-Konstante (also z.B. "D:\Abraham\Projekte\Frühförderung\Rohdaten\pages\test\" statt "D:\Abraham\Projekte\Frühförderung\Rohdaten\pages\"). Dann geht das Makro auch nur diese Dateien durch und wenn du damit zufrieden bist, stellst Du das Verzeichnis wieder um.
Gruß
Sheldon

AW: testen...
12.02.2013 22:37:28
Stephan
hmmm
leider nein
öffnet wieder 10.html aber tut nichts außer Laufzeitfehler 1004 (der ja "sehr" aussagekräftig ist) im fett markierten feld (Range C3)
Sub Einlesen()
Dim oFSO As Variant
Dim oFolder As Variant
Dim oFile As Variant
Dim oWB As Variant
Const Workpath As String = "H:\Projekte\Frühförderung\Rohdaten\pages"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(Workpath)
For Each oFile In oFolder.Files
Set oWB = Workbooks.Open(Filename:=oFile)
Range("B4:C4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
oWB.Activate
Cells.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Range("B4").End(xlDown).Offset(1, 0).Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
oWB.Activate
Range("B6").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("B3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B7").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("C3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B6").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
oWB.Activate
Range("B5").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("D3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("E4").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Range("E5").End(xlDown).Offset(1, 0).Select
Windows("Datenbank2.xlsm").Activate
Range("E3").Select
ActiveSheet.Paste
oWB.Activate
Range("E5").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("F3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("E6").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("G3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("E8").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("H3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Range("I3").End(xlDown).Offset(1, 0).Select
oWB.Activate
Range("E9").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
oWB.Activate
Range("B11").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("J3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B12").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("K3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B13").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("L3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B14").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("M3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
ActiveWindow.Close savechanges:=False
Next
End Sub

Anzeige
AW: testen...
12.02.2013 22:59:11
Sheldon
ok, die Spalten dürfen in der DB nicht leer sein, wenn das funktionieren soll... Als Workaround geht diese Zeile:
If Not IsEmpty(Range("C3")) Then Range("C3").End(xlDown).Offset(1, 0).Select Else Range("C3").Select
Viel besser noch wäre es, Du würdest einfach überall in den Zellen in Zeile 3 eine Spaltenüberschrift eintragen. Dann umgehst Du das Problem auf elegante Weise.
Aber Du hast m. E. an einigen Stellen falsch korrigiert:
Sub Einlesen()
Dim oFSO As Variant
Dim oFolder As Variant
Dim oFile As Variant
Dim oWB As Variant
Const Workpath As String = "H:\Projekte\Frühförderung\Rohdaten\pages"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(Workpath)
For Each oFile In oFolder.Files
Set oWB = Workbooks.Open(Filename:=oFile)
Range("B4:C4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
oWB.Activate
Cells.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Range("B4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
oWB.Activate
Range("B6").End(xlDown).Offset(1, 0).Select 'Hier wieder falsch, Du bist jetzt in  _
oWB
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("B3").End(xlDown).Offset(1, 0).Select 'Hier ist es richtig
ActiveSheet.Paste
oWB.Activate
Range("B7").End(xlDown).Offset(1, 0).Select 'und wieder falsch, muss Range("B7"). _
Selectr heißen
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("C3").End(xlDown).Offset(1, 0).Select 'richtig
ActiveSheet.Paste
oWB.Activate
Range("B6").End(xlDown).Offset(1, 0).Select 'falsch
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate 'wozu Datenbank aktivieren, wenn direkt der nä _
chste Befehl wieder oWB aktiviert?
oWB.Activate
Range("B5").End(xlDown).Offset(1, 0).Select 'falsch
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("D3").End(xlDown).Offset(1, 0).Select 'richtig
ActiveSheet.Paste
oWB.Activate
Range("E4").End(xlDown).Offset(1, 0).Select 'wieder falsch
Application.CutCopyMode = False
Selection.Copy
Range("E5").End(xlDown).Offset(1, 0).Select 'Zeile ist ganz falsch, raus damit
Windows("Datenbank2.xlsm").Activate
Range("E3").Select 'Hier fehlt nun das End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("E5").End(xlDown).Offset(1, 0).Select 'wieder falsch
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("F3").End(xlDown).Offset(1, 0).Select 'richtig
ActiveSheet.Paste
oWB.Activate
Range("E6").End(xlDown).Offset(1, 0).Select 'und wieder falsch...
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("G3").End(xlDown).Offset(1, 0).Select 'richtig
ActiveSheet.Paste
oWB.Activate
Range("E8").End(xlDown).Offset(1, 0).Select 'wieder falsch
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("H3").End(xlDown).Offset(1, 0).Select 'richtg
ActiveSheet.Paste
Range("I3").End(xlDown).Offset(1, 0).Select
oWB.Activate
Range("E9").End(xlDown).Offset(1, 0).Select 'falsch - naja und so weiter, hab keine  _
Lust mehr weiter zu kommentieren ... ;-)
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
oWB.Activate
Range("B11").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("J3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B12").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("K3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B13").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("L3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B14").End(xlDown).Offset(1, 0).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("M3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
ActiveWindow.Close savechanges:=False
Next
End Sub

Gruß
Sheldon

Anzeige
AW: testen...
12.02.2013 23:05:22
Stephan
ja sry klemm da schon den ganzen tag davor und versuch sachen oder lese was nach mit meinem geringen wissen in sachen programimerung.
irgendwann fehtl einfach die konzentration
bzw is man dann irgendwann auch mal frustiert.

AW: testen...
12.02.2013 23:15:15
Sheldon
Oh ja, das kenne ich gut!
Nimm Dir etwas Zeit, das ist ein echt großes Projekt, wenn Du gerade erst anfängst, Pgmieren zu lernen! Es gibt sehr, sehr viele Lösungen für diese Anforderung, manche davon einfach, andere schwierig. Versuchs doch einfach morgen weiter, ausgeschlafen denkt es sich gleich wieder viel leichter ;-)
Gruß
Sheldon

Anzeige
AW: testen...
12.02.2013 23:24:55
Stephan
so habs nochmal überarbeitet
naja ich brauch das halt aber 1206 Datensätze öffnen und per hand kopieren?! Dann lieber so per Makro und gleich mal etwas Programmierung reingeschaut ;)
Aber immer noch Laufzeitfehler 1004 bei Range B3 so es richtig sein sollte.
Ich hab auch in jedes beschriebene Feld der Tabelle ein a geschrieben.
in A3 schreibt er das erste Feld noch korekt rein aber ab B3 streikt das Makro.
Sub Einlesen()
Dim oFSO As Variant
Dim oFolder As Variant
Dim oFile As Variant
Dim oWB As Variant
Const Workpath As String = "H:\Projekte\Frühförderung\Rohdaten\pages"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(Workpath)
For Each oFile In oFolder.Files
Set oWB = Workbooks.Open(Filename:=oFile)
Range("B4:C4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
oWB.Activate
Cells.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Range("B4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
oWB.Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
 Range("B3").End(xlDown).Offset(1, 0).Select 'Hier ist es richtig
ActiveSheet.Paste
oWB.Activate
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("C3").End(xlDown).Offset(1, 0).Select 'richtig
ActiveSheet.Paste
oWB.Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
' Windows("Datenbank2.xlsm").Activate 'wozu Datenbank aktivieren, wenn direkt der nä _
chste Befehl wieder oWB aktiviert?
oWB.Activate
Range("B5").Select 'falsch
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("D3").End(xlDown).Offset(1, 0).Select 'richtig
ActiveSheet.Paste
oWB.Activate
Range("E4").Select 'wieder falsch
Application.CutCopyMode = False
Selection.Copy
'Range("E5").Select -----> 'Zeile ist ganz falsch, raus damit
Windows("Datenbank2.xlsm").Activate
Range("E3").End(xlDown).Select
ActiveSheet.Paste
oWB.Activate
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("F3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("G3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("H3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Range("I3").End(xlDown).Offset(1, 0).Select
oWB.Activate
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
oWB.Activate
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("J3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("K3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("L3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("M3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
ActiveWindow.Close savechanges:=False
Next
End Sub

Anzeige
AW: testen...
12.02.2013 23:44:52
Sheldon
Gut. Jetzt hast Du leider diese eine Zeile nirgends eingebaut. Macht nix, hab ich jetzt mal gemacht.
Sub Einlesen()
Dim oFSO As Variant
Dim oFolder As Variant
Dim oFile As Variant
Dim oWB As Variant
Const Workpath As String = "H:\Projekte\Frühförderung\Rohdaten\pages"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(Workpath)
For Each oFile In oFolder.Files
Set oWB = Workbooks.Open(Filename:=oFile)
Range("B4:C4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
oWB.Activate
Cells.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Range("B4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
oWB.Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("B3")) Then Range("B2").End(xlDown).Offset(1, 0).Select Else  _
Range("B3").Select
ActiveSheet.Paste
oWB.Activate
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("C3")) Then Range("C2").End(xlDown).Offset(1, 0).Select Else  _
Range("C3").Select
ActiveSheet.Paste
oWB.Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
oWB.Activate
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("D3")) Then Range("D2").End(xlDown).Offset(1, 0).Select Else  _
Range("D3").Select
ActiveSheet.Paste
oWB.Activate
Range("E4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("E3")) Then Range("E2").End(xlDown).Offset(1, 0).Select Else  _
Range("E3").Select
Range("E3").End(xlDown).Select
ActiveSheet.Paste
oWB.Activate
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("F3")) Then Range("F2").End(xlDown).Offset(1, 0).Select Else  _
Range("F3").Select
Range("F3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("G3")) Then Range("G2").End(xlDown).Offset(1, 0).Select Else  _
Range("G3").Select
Range("G3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Activate
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("H3")) Then Range("H2").End(xlDown).Offset(1, 0).Select Else  _
Range("H3").Select
Range("H3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
If Not IsEmpty(Range("I3")) Then Range("I2").End(xlDown).Offset(1, 0).Select Else  _
Range("I3").Select
oWB.Activate
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
oWB.Activate
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("J3")) Then Range("J2").End(xlDown).Offset(1, 0).Select Else  _
Range("J3").Select
ActiveSheet.Paste
oWB.Activate
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("K3")) Then Range("K2").End(xlDown).Offset(1, 0).Select Else  _
Range("K3").Select
ActiveSheet.Paste
oWB.Activate
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("L3")) Then Range("L2").End(xlDown).Offset(1, 0).Select Else  _
Range("L3").Select
ActiveSheet.Paste
oWB.Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
If Not IsEmpty(Range("M3")) Then Range("M2").End(xlDown).Offset(1, 0).Select Else  _
Range("M3").Select
Range("M3").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
oWB.Close savechanges:=False
Next
End Sub

Gruß
Sheldon

Anzeige
AW: testen...
13.02.2013 07:28:11
Stephan
Cool danke sieht natürlich viel geordneter aus also bei mir.
nun kopiert es scheinbar alles bis E3 aber bei F3 kommt wieder mein lieblingsfehler 1004
ich hab mal geschaut in F3 müsste eine Handynr stehen aber in der Quelldatei steht nicht immer ne handynr. Aber sollte ja eigentlich kein Problem sein davor sind ja auch schon 1-2 Leerfelder durchgelaufen (wie zB C3 Ort)
Oh ich seh gerade ab ab F3 is das Range("F3").End(xlDown).Offset(1, 0).Select fortlaufend drin.
Das heißt dann wohl normal würde es die 4 Dateien im Ordner alle durchlaufen aber erst ab F3 untereinander schreiben, wenn es nicht in den Fehler laufen würde.

AW: testen...
13.02.2013 08:23:21
Sheldon
Guten Morgen, Stephan!
Teste mal...
Sub Einlesen()
Dim oFSO As Variant
Dim oFolder As Variant
Dim oFile As Variant
Dim oWB As Variant
Dim Cntr As Long
Const Workpath As String = "H:\Projekte\Frühförderung\Rohdaten\pages"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(Workpath)
Cntr = 3
For Each oFile In oFolder.Files
Cntr = Cntr + 1
Set oWB = Workbooks.Open(Filename:=oFile)
oWB.Activate
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 1) = oWB.Sheets(1).Range("B4")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 2) = oWB.Sheets(1).Range("B6")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 3) = oWB.Sheets(1).Range("B7")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 4) = oWB.Sheets(1).Range("B5")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 5) = oWB.Sheets(1).Range("E4")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 6) = oWB.Sheets(1).Range("E5")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 7) = oWB.Sheets(1).Range("E6")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 8) = oWB.Sheets(1).Range("E8")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 9) = oWB.Sheets(1).Range("E9")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 10) = oWB.Sheets(1).Range("B11")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 11) = oWB.Sheets(1).Range("B12")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 12) = oWB.Sheets(1).Range("B13")
Windows("Datenbank2.xlsm").Sheets(1).Cells(Cntr, 13) = oWB.Sheets(1).Range("B14")
oWB.Close savechanges:=False
Next
End Sub

Gruß
Sheldon

AW: testen...
13.02.2013 08:44:58
Stephan
wow das is natürlich deutlich schlanker und eleganter.
das Cntr versteh ich nicht ganz ich vermute es bezieht sich auf die Zeilen da es ja mit Cntr = 3 anfängt
aber es läuft nach Selection.unmerge (also wo es das kopieren und einfügen starten sollte) in Fehler 424 Object erforderlich.
was mir aufgefallen ist du beziehst es ja in diesem script aus oFiles, dass ging bei mir nicht ich musste es in einer collection (List1) speichern und dann per add in Files speichern, fehlt das hier vlt?

AW: testen...
13.02.2013 08:54:32
Sheldon
Ersetze mal Windows("Datenbank2xlsm") durch Workbooks("Datenbank2.xlsm")
dann wirds wohl laufen...
Gruß
Sheldon

AW: testen...
13.02.2013 09:22:53
Stephan
Funktioniert 1A, ist sauber und sieht auch noch total elegant aus.
Vielen vielen Dank.
Es startet zwar in Zeile 4 statt in 3 aber die wird dann einfach gelöscht und gut.
was ich Gerne noch wüsste ist (ich will es ja auch ganz verstehen)
-du Startest mit Cntr = 3 also fängt er das schreiben in Zeile 3 an
-dann kommt Cntr + 1 damit fängt er dann eine Tiefer an (warum es dann auch in Zeile 4 loslegt)
-bei kopieren und einfügen kommt dann Cntr,1 usw
also wie genau funktioniert das bzw arbeitet das Cntr?
eine Variable ist es nicht denn sie wird ja nicht deklariert aber beim kopieren einfügen sieht es aus wie eine.

AW: testen...
13.02.2013 09:42:48
Sheldon
Hi Stephan,
Cntr ist eine Variable, sie wird mit der Anweisung Dim Cntr As Long deklariert. Long ist ein Variablentyp wie Integer, jedoch speichert Integer Ganzzahlen im Bereich -32768 bis 32767. Ein Excel-Blatt bis vor V2007 besitzt aber 65536 Zeilen, also könnte Integer irgendwann nicht mehr ausreichen. Long speichert Ganzzahlen von -2.147.483.648 bis 2.147.483.647, reicht also auch für Tabellenblätter in Xl-Versionen ab 2007.
Wenn Du das löschen der leeren Zeile vermeiden willst, dann ändere die Zeile Cntr = 3 entsprechend um in Cntr = 2.
Mit dem Begriff Cells(Cntr, 2) zum Beispiel sprichst Du die Zelle (auch Range genannt) in der Zeile an, die der Zahl gespeichert in Cntr entspricht und der zweiten Spalte, also B. Daraus ergibt sich dann z.B. die Zelle B2, wenn Cntr=2 ist. Freilich ist die Reihenfolge in den beiden Notationsarten zu beachten: B2 beschreibt zuerst die Spalte, dann als Ziffer die Zeile, während Cells(2, 2) zuerst die Zeile, dann die Spalte jeweils als Ziffer beschreibt.
Ich hoffe, meine Erklärungen waren einigermaßen verständlich! Im Grunde ist diese Aufgabe m.E. zu schwierig, um erste Schritte beim Programmieren zu machen. Aber andererseits braucht es ja auch eine starke Motivation, und die hattest Du ganz offensichtlich, denn Du hast nicht locker gelassen. Das rechne ich Dir hoch an! Ich hoffe, Dich nicht zu sehr verschreckt zu haben. Programmieren ist kein Hexenwerk, aber es braucht natürlich reichlich Übung und Erfahrung, bis sich Makros flüssig schreiben lassen.
Gruß
Sheldon

AW: testen...
13.02.2013 10:02:29
Stephan
Ja danke habs verstanden.
das mit (spalte,zelle) hatte ich eigentlich schon, hätte ich auch drauf kommen können ^^
ich find das auch total interessant mit dem programmieren aber bisher war ich froh wenn ich bei C# einen taschenrecher mit +-*/ sauber hinbekommen hab bei mehr wurde es schon echt schwierig.
naja es war ne Frage von jemanden ob ich das mal machen könnte und hab gesagt ich schau es mir mal an.
und dann gings los
-wie öffne ich eine Datei
-bzw mehr Dateien mit makros
-wie übertrage ich nun Daten von einer in die nächste Datei
das hab ich indem Fall lange zwischen der Datenbank2 und der 7.html versucht
dann kam ich auf die idee mit dem Makro aufzeichnen und das hab ich immer wieder versucht bis es mit der 7.html sauber durch ging (wobei man die aufzeichnungen noch an etlichen stellen bearbeiten musste)
das nächste problem war dann: wie mach ich das nun auf die restlichen 1205 Dateien, da meinte ein Kollege schau mal nach FSO
das hab ich dann gemacht und er half mir etwas
aber hast ja gesehen von da an gings nicht weiter das eckte überall an auch wenn in list1 der richtige wert stand.
Naja wie dem auch sei nun hab ich auch mal die elegante lösung gesehen
also nochmals vielen vielen dank

freut mich, danke für die RM! owT
13.02.2013 10:28:39
Sheldon
Gruß
Sheldon

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige