Export von Daten aus einer in andere Datei mit VBA (Laufzeitfehler)
#1
Hallo zusammen,

ich habe mir vor kurzem ein Makro in VBA zusammengebastelt, bei dem aus meiner geöffneten Excel-Datei die Gesamte Zeile 4 in eine andere Datei kopiert wird (auf 2 verschiedene Blätter), in der die Daten gesammelt werden sollen. Bevor ich das Makro benutze habe ich die zu exportierenden Daten bereits u.a. mit Makros bearbeitet. Unter Windows 7 und mit Office Professional Plus 2013 funktioniert das ganze einwandfrei. Probiere ich das ganze unter Windows 10 (gleiche Office Version) auf meinem Laptop, bekomme ich immer wieder einen Laufzeitfehler "Automatisierungsfehler - Das aufgerufene Objekt wurde von den Clients getrennt." Schließe ich die Exceldatei und öffne sie wieder, funktioniert das Makro auch hier wieder problemlos. Weiß jemand woran das liegt?

Bei Google findet man unzählige Einträge darüber, aber aufgrund meiner schwachen VBA Kenntnisse (wie man am Code evtl. sieht) konnte ich für mich bisland keine Lösung herausfiltern.

Lieben Gruß

Zitat:Sub Daten_exportieren()
'Daten in Datensammlung übertragen'
Dim varGruppe As String
Dim Auswertung As String
Dim Dateipfad As String
Dateipfad = ThisWorkbook.Worksheets("Metadaten").Range("G1").Text
Auswertung = ThisWorkbook.Name
varGruppe = ThisWorkbook.Worksheets("Metadaten").Range("C4").Text
Worksheets("Metadaten").Rows("4:4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Open Filename:=Dateipfad
    'Gruppentabelle'
    Worksheets(varGruppe).Activate
    Worksheets(varGruppe).Rows("11:11").Insert Shift:=xlDown
    Rows("11:11").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Copy
    'Gesamttabelle'
    Worksheets("Gesamt").Activate
    Rows("11:11").Insert Shift:=xlDown
    Rows("11:11").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub
Top
#2
Hallo

ich habe mal versucht den Code zu optimieren, weiss aber nicth ob er so funktioniert. Es gibt auch vba "Leichen", überflüssiger Code -ohne- Funktion!!
Wenn die Zeilen von 4:11 verschoben werden sollen würde ich das vor dem Kopieren machen. Ich hoffe ich habe es richtig verstanden. 

mfg  Gast 123

Code:
'entfernete_Leichen:
'Dim Auswertung As String   'überflüssig  s. ThisWorkbbok.Name
'Auswertung = ThisWorkbook.Name


Sub Daten_exportieren()
'Daten in Datensammlung übertragen'
Dim varGruppe As String
Dim Dateipfad As String
   Dateipfad = ThisWorkbook.Worksheets("Metadaten").Range("G1").Text
   varGruppe = ThisWorkbook.Worksheets("Metadaten").Range("C4").Text
   
   Workbooks.Open Filename:=Dateipfad
   'zuerst Zellen nach unten verschieben
   ActiveWorkbook.Worksheets(varGruppe).Rows("11:11").Insert Shift:=xlDown
   ActiveWorkbook.Worksheets("Gesamt").Rows("11:11").Insert Shift:=xlDown
   
   'etadaten in freie Zellen kopieren
   Worksheets("Metadaten").Rows("4:4").Copy
   ActiveWorkbook.Worksheets(varGruppe).Rows("11:11").PasteSpecial Paste:=xlPasteValues
   ActiveWorkbook.Worksheets("Gesamt").Rows("11:11").PasteSpecial Paste:=xlPasteValues
   
   Application.CutCopyMode = False
   ActiveWorkbook.Save
   ActiveWindow.Close
End Sub
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste