shaggy84
Goto Top

Inhalte von Datei zu Datei kopieren mit Schleifen Makro

Hallo Administrator Forum Team,

wieder einmal stehe ich vor einem kleinem Problem.

Ich kopiere Tabelleninhalte von einer Quelldatei in meine Zieldatei. Dies funktioniert soweit.

Jetzt aber die beiden Schleifenpunkte, die noch nicht funktionieren:
- in der Quelldatei können es mehrere Tabellen sein, deren Inhalt ich kopieren will (immer ab der ersten)
- in der Zieltabelle möchte ich alle Werte untereinander stehen haben

[j ist die Anzahl der Tabellen, die ich aus der Quelldatei importieren möchte. k = 1]

Do Until k = j + 1

    'Inhalte kopieren  
    Worksheets(k).Range("8:65535").Copy  

    'Inhalte einfügen  
    If Ziel.Worksheets(2).Cells(1, 1) = "" Then  
    Ziel.Worksheets(2).Range("1:65535").PasteSpecial _  
    Paste:=xlPasteValues
    Else
    Letzte = IIf(IsEmpty(Ziel.Worksheets(2).Range("E65536")), Ziel.Worksheets(2).Range("E65536").End(xlUp).Row + 1, 65536)  
    'ab hier funktioniert es nicht mehr  
    Ziel.Worksheets(2).Cells(Letzte, 1).PasteSpecial _
    Paste:=xlPasteValues
    End If

    k = k + 1

Loop

Ich habe das Gefühl, als ob mein Programmablauf nach einem Durchgang, nicht mehr in die Quelldatei zurück wechselt. Wie kann ich dieses Problem lösen?

Außerdem kopiert er nicht unter meine bestehenden Daten hinzu. Es passiert einfach nichts, wenn ich den Programmablauf noch einmal von vorne mit einer anderen Datei starte. Woran kann dies liegen?

Grüße

Content-Key: 86216

Url: https://administrator.de/contentid/86216

Printed on: April 16, 2024 at 22:04 o'clock

Member: bastla
bastla Apr 23, 2008 at 13:42:28 (UTC)
Goto Top
Hallo Shaggy84!

Einmal abgesehen von der etwas abenteuerlichen Schleife (wenn Du die Anzahl der Tabellen kennst und diese schon unbedingt in einer Variable "j" speichern musst, wäre zumindest eine Zählschleife der Art
For k = 1 To j
...
Next
die üblichere Schreibweise, ansonsten aber wenigstens "Do While k <= j"), gibt es zwei echte Probleme:

Zunächst hast Du zwar für die Zielmappe eine Variable ("Ziel") verwendet, nicht aber für die Quelle - falls das Makro aus der Quellmappe heraus gestartet wird, könntes Du das etwa so nachholen
Set Quelle = ThisWorkbook
und dann vor dem jeweilgen Kopiervorgang ein
Quelle.Worksheets(k).Activate
einbauen.

Außerdem wird es Dir (ein Excel < 2007 vorausgesetzt) auch von Hand nicht gelingen, in einer Tabelle 65528 Zeilen (wieso sparst Du eigentlich die Zeile 65536 aus?) zu markieren und diese in einer anderen Tabelle zB ab Zeile 200 wieder einzufügen - insofern wird es nötig sein, den zu kopierenden Bereich in der Quellmappe einzugrenzen, etwa mit
Range("A8", ActiveCell.SpecialCells(xlLastCell)).Copy  
Schließlich könntest Du dann noch (der Ordnung halber) nach der Schleife den (eigentlich noch offenen) Kopiervorgang mit
Application.CutCopyMode = False
abbrechen ...

Grüße
bastla
Member: Shaggy84
Shaggy84 Apr 24, 2008 at 07:20:26 (UTC)
Goto Top
Hallo bastla und andere,

danke für die Hinweise. Ja meine Schleife war komisch, suchte auch dieses "For times".

Dann das mit der letzten benutzten Zelle, jap, das suchte ich auch und fand es nicht. Danke

Jetzt kommen die Probleme:
Zuerst, ich starte das Makro aus der Zieldatei heraus und möchte die Quelldatei daraus öffnen und Daten kopieren. Das klappte schon das ein oder andere mal, jetzt leider wieder nicht.

Ab dem Code mit der letzten benutzten Zelle
Range("A8", ActiveCell.SpecialCells(xlLastCell)).Copy  
erscheint der Laufzeitfehler 424 Objekt nicht gefunden?!

Debuggen kann ich meinen Code leider nicht, da mein Excel dann abstürzt. (Evt. wegen Makro in der anderen Datei.). Hab's nur mit "On Error Resume Next" einkreisen können.

Wenn ich aber anstatt sowohl in dem Kopier- als auch Einfügebereich (jetzt vereinfacht)
Range("A1") 'oder Range("1:65535")  
anstatt
Range(Cells(1, 1)) 'oder andere Zellverweise  
benutze, funktioniert es wieder. Nur damit kann man ja nicht flexibel arbeiten.

Ich hab hier noch einmal den Code Auszug, der für das kopieren wichtig ist komplett (j=1)
Sub Source_File_Import()

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.CutCopyMode = False
Application.StatusBar = "Achtung! - Makro läuft"  
Dim app As New Excel.Application 'für Autovervollständigung  

Dim Letzte As Long
Dim i As Integer 'für Abbruchbedingung beim Datei Laden  
Dim Ziel As Workbook
Set Ziel = ThisWorkbook 'für Zielbestimmung  
Dim j As Integer 'für Anzahl der Tabellenblätter der Quelle  
j = Ziel.Worksheets(1).Cells(9, 9).Value
Dim k As Integer 'für Zähler  
k = 1

'Datei öffnen  
i = Application.Dialogs(xlDialogOpen).Show
If i = 0 Then
Application.StatusBar = ""  
Exit Sub
End If

For k = 1 To j

    'Inhalte kopieren  
    Worksheets(k).Activate
    Worksheets(k).Range("A8", ActiveCell.SpecialCells(xlLastCell)).Copy  

    'Inhalte einfügen  
    If Ziel.Worksheets(2).Cells(1, 1) = "" Then  
    Ziel.Worksheets(2).Range(Cells(1, 1)).PasteSpecial _
    Paste:=xlPasteValues
    Else
    Letzte = IIf(IsEmpty(Ziel.Worksheets(2).Range("E65536")), Ziel.Worksheets(2).Range("E65536").End(xlUp).Row + 1, 65536)  
    Ziel.Worksheets(2).Range(Cells(Letzte, 1)).PasteSpecial _
    Paste:=xlPasteValues
    End If

Next k

'......  

Application.StatusBar = ""  
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.CutCopyMode = True

End Sub

Woran kann's noch hapern?

Außerdem als Idee zum zurück wechseln in die Quelldatei nach einem Schleifendurchlauf war
Dim Quelle As Workbook
i = Application.Dialogs(xlDialogOpen).Show
Set Quelle = ActualWorkbook
'....  
Quelle.Worksheets(k).Activate
Das klappte aber leider noch nicht...

Ich bin für jede Idee dankbar face-smile
Member: bastla
bastla Apr 24, 2008 at 10:24:42 (UTC)
Goto Top
Hallo Shaggy84!

Deine "Idee zum zurück wechseln in die Quelldatei" wäre auch meine, allerdings sollte die "Set"-Zeile lauten:
Set Quelle = ActiveWorkbook

Hinsichtlich des zu kopierenden Bereiches: Gibt es vielleicht eine Spalte (für das Beispiel unten Spalte A), die in jeder Zeile einen Wert enthält (zB eine laufende oder Artikel-Nr etc) - dann würde ich dort ansetzen und die letzte Zeile so suchen:
k = 8
Do While Cells(k, "A").Value <> ""  
    k = k + 1
Loop
LetzteZeile = k - 1

Grüße
bastla
Member: Shaggy84
Shaggy84 Apr 29, 2008 at 08:53:43 (UTC)
Goto Top
Hallo bastla,

vielen Dank für die Hilfe. Leider kann ich nicht sagen, ob ein Einladen mehrerer Worksheets direkt nacheinander funktioniert. Ich lade Dateien ein, die selber Autostart Makros haben, und die machen mir in diesem Fall das Leben schwer. Diese einzeln über eine Variable nacheinander zu laden funktioniert allerdings.

Die anderen Punkte sind aber verbaut und funktionieren wunderbar. Danke nochmals.


Shaggy