VBA - finde den Fehler nicht

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

VBA - finde den Fehler nicht

VBA - finde den Fehler nicht von D.Hensel vom 29.08.2014 09:20:48

AW: VBA - finde den Fehler nicht - von Daniel am 29.08.2014 09:28:43
- AW: VBA - finde den Fehler nicht - von D.Hensel am 29.08.2014 09:40:57
  - AW: VBA - finde den Fehler nicht - von Daniel am 29.08.2014 10:18:21
    - AW: VBA - finde den Fehler nicht - von D.Hensel am 29.08.2014 10:44:10
AW: VBA - finde den Fehler nicht - von Rudi Maintaire am 29.08.2014 10:14:40
- AW: VBA - finde den Fehler nicht - von D.Hensel am 29.08.2014 10:21:08
  - AW: VBA - finde den Fehler nicht - von Rudi Maintaire am 29.08.2014 10:50:56
    - AW: VBA - finde den Fehler nicht - von D.Hensel am 29.08.2014 11:01:12
      - AW: VBA - finde den Fehler nicht - von Rudi Maintaire am 29.08.2014 11:11:04
        
        AW: VBA - finde den Fehler nicht - von D.Hensel am 29.08.2014 11:16:44
        
        AW: VBA - finde den Fehler nicht - von Rudi Maintaire am 29.08.2014 11:30:36
        
        AW: VBA - finde den Fehler nicht - von D.Hensel am 29.08.2014 11:34:41
        
        da kann ich auch nicht helfen - von Rudi Maintaire am 29.08.2014 12:21:25
        
        AW: da kann ich auch nicht helfen - von D.Hensel am 29.08.2014 12:50:15
        
        AW: da kann ich auch nicht helfen - von Daniel am 29.08.2014 13:42:45
        
        AW: da kann ich auch nicht helfen - von D.Hensel am 29.08.2014 13:49:20

Betrifft: VBA - finde den Fehler nicht von: D.Hensel
Geschrieben am: 29.08.2014 09:20:48

Möchte mit dem Macro 5 Dateien in ein Workbook importieren und umbennnen.
Ich erhalte immer bei dem Part wo das 2. Workbook importiert werden soll einen Laufzeitfehler: -2147221080 (800401a8)
Automatisierungsfehler

Sub ImportFiles()
    ChDrive "X"
    ChDir "X:\Makro Test"
       
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wb5 As Workbook
    Dim Ret1, Ret2, Ret3, Ret4, Ret5

    Set wb1 = ActiveWorkbook

    '~~> Get the first File
    Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Opening Stock ZR141")
    If Ret1 = False Then Exit Sub

    '~~> Get the 2nd File
    Ret2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Closing Stock ZR141")
    If Ret2 = False Then Exit Sub
    
     '~~> Get the 3rd File
    Ret3 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "MB5B Opening Stock")
    If Ret3 = False Then Exit Sub
    
        '~~> Get the 4th File
    Ret4 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "MB5B Closing Stock")
    If Ret4 = False Then Exit Sub
    
           '~~> Get the 5th File
    Ret5 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Masterdata")
    If Ret5 = False Then Exit Sub
    
     
    'Change name and open workbooks
     Set wb1 = Workbooks.Open(Ret1)
    wb1.Sheets(1).copy wb1.Sheets(1)
    ActiveSheet.Name = "ZR141 Opening Stock"
    wb1.Close savechanges:=False

    Set wb2 = Workbooks.Open(Ret2)
   wb2.Sheets(1).copy wb1.Sheets(2)   
    ActiveSheet.Name = "ZR141 Closing Stock"
    wb2.Close savechanges:=False
  
    Set wb3 = Workbooks.Open(Ret3)
    wb3.Sheets(1).copy wb1.Sheets(3)
    ActiveSheet.Name = "MB5B Opening Stock"
    wb3.Close savechanges:=False
    
    Set wb4 = Workbooks.Open(Ret4)
    wb4.Sheets(1).copy wb1.Sheets(4)
    ActiveSheet.Name = "MB5B Closing Stock"
    wb4.Close savechanges:=False
    
    Set wb5 = Workbooks.Open(Ret5)
    wb5.Sheets(1).copy wb1.Sheets(5)
    ActiveSheet.Name = "Masterdata"
    wb5.Close savechanges:=False
    
    Set wb2 = Nothing
    Set wb3 = Nothing
    Set wb4 = Nothing
    Set wb5 = Nothing
    Set wb1 = Nothing
    
   End Sub

Der Debugger stoppt bei dem fett markierten Teil. (wb2.Sheets(1).copy wb1.Sheets(2) )

Vielen Dank für eure Hilfe

Betrifft: AW: VBA - finde den Fehler nicht von: Daniel
Geschrieben am: 29.08.2014 09:28:43

Hi

du kannst in VBA nur mit geöffneten Dateien arbeiten.
wenn du das wb1 kurz vorher schließt, dann kannst du es in der Folge nicht mehr verwenden und bearbeiten.

 wb1.Close savechanges:=False '<---- nicht schließen, wenn noch benötigt !

    Set wb2 = Workbooks.Open(Ret2)
   wb2.Sheets(1).copy wb1.Sheets(2)

Gruß Daniel

Betrifft: AW: VBA - finde den Fehler nicht von: D.Hensel
Geschrieben am: 29.08.2014 09:40:57

Hallo Daniel, danke für die Antwort. Wenn ich das close entferne, erhalte ich den Fehler nicht mehr. Habe aber zwei weitere Probleme jetzt:

1. Dann habe ich am Ende 6 offene Dateien. Würde gerne aber nur die eine geöffnet haben. Das close ans Ende zu packen hat auch nicht funktioniert.
2. Das 5. Workbook wird falsch kopiert. Es wird eine andere Datei kopiert als ich ausgewählt hab

Danke und VG!

Betrifft: AW: VBA - finde den Fehler nicht von: Daniel
Geschrieben am: 29.08.2014 10:18:21

Hi
du kannst die Dateien ja schließen, wenn du sie nicht mehr benötigst (dh spätestens zum Ende des Makros).
Solange du aber noch mit ihnen arbeiten willst, müssen sie geöffnet bleiben.
Wenn das falsche Workbook kopiert wird, dann hast du dich irgendwo vertippt und musst das korrigieren und ein anderes auswählen.

Gruß Daniel

Betrifft: AW: VBA - finde den Fehler nicht von: D.Hensel
Geschrieben am: 29.08.2014 10:44:10

Danke für die Infos. Habe das close drin behalten und die close variablen umbenannt von wb2-wb6, da ich das activeworkbook ja nicht closen will. Habe aber immer noch den Fehler mit dem Automation error, diesmal direkt beim öffnen der ersten Datei.

VG

Sub ImportFiles()
    ChDrive "X"
    ChDir "X:\Test"
       
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wb5 As Workbook,  _
wb6 As Workbook
    Dim Ret1, Ret2, Ret3, Ret4, Ret5
    Set wb1 = ActiveWorkbook
    
    '~~> Get the first File
    Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Opening Stock ZR141")
    If Ret1 = False Then Exit Sub

    '~~> Get the 2nd File
    Ret2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Closing Stock ZR141")
    If Ret2 = False Then Exit Sub
    
     '~~> Get the 3rd File
    Ret3 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "MB5B Opening Stock")
    If Ret3 = False Then Exit Sub
    
        '~~> Get the 4th File
    Ret4 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "MB5B Closing Stock")
    If Ret4 = False Then Exit Sub
    
           '~~> Get the 5th File
    Ret5 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Masterdata")
    If Ret5 = False Then Exit Sub
    
      
    'Change name and open workbooks
    Set wb2 = Workbooks.Open(Ret2)
    wb2.Sheets(1).copy wb1.Sheets(1)
    ActiveSheet.Name = "ZR141 Closing Stock"
    wb2.Close savechanges:=False
  
    Set wb3 = Workbooks.Open(Ret3)
    wb3.Sheets(1).copy wb1.Sheets(2)
    ActiveSheet.Name = "MB5B Opening Stock"
    wb3.Close savechanges:=False
    
    Set wb4 = Workbooks.Open(Ret4)
    wb4.Sheets(1).copy wb1.Sheets(3)
    ActiveSheet.Name = "MB5B Closing Stock"
    wb4.Close savechanges:=False
    
    Set wb5 = Workbooks.Open(Ret5)
    wb5.Sheets(1).copy wb1.Sheets(4)
    ActiveSheet.Name = "Masterdata"
    wb5.Close savechanges:=False
    
    Set wb6 = Workbooks.Open(Ret1)
    wb6.Sheets(1).copy wb1.Sheets(5)
    ActiveSheet.Name = "ZR141 Opening Stock"
    
    Set wb2 = Nothing
    Set wb3 = Nothing
    Set wb4 = Nothing
    Set wb5 = Nothing
    Set wb1 = Nothing
    Set wb6 = Nothing
    
   End Sub

Betrifft: AW: VBA - finde den Fehler nicht von: Rudi Maintaire
Geschrieben am: 29.08.2014 10:14:40

Hallo,
erst setzt du wb1=Activeworkbook und später

      'Change name and open workbooks
       Set wb1 = Workbooks.Open(Ret1)
      wb1.Sheets(1).copy wb1.Sheets(1)
      ActiveSheet.Name = "ZR141 Opening Stock"
      wb1.Close savechanges:=False

Gruß
Rudi

Betrifft: AW: VBA - finde den Fehler nicht von: D.Hensel
Geschrieben am: 29.08.2014 10:21:08

Hallo Rudi, danke. Habe den Fehler nicht mehr. Habe jetzt ein seltsames Problem, dass das 5. Workbook identisch mit dem ersten ist (nur mit anderer Bezeichnung). Kriege keine Fehlermeldung aber die 5. Datei wird falsch importiert. Habe einfach das wb1.close entfernt aus dem script. Hatte erst versucht wb6 zu benutzen, da kamen dann andere Fehler.

Option Explicit

Sub ImportFiles()
    ChDrive "X"
    ChDir "X:\Makro Test"
       
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wb5 As Workbook,  _
wb6 As Workbook
    Dim Ret1, Ret2, Ret3, Ret4, Ret5

    Set wb1 = ActiveWorkbook

    '~~> Get the first File
    Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Opening Stock ZR141")
    If Ret1 = False Then Exit Sub

    '~~> Get the 2nd File
    Ret2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Closing Stock ZR141")
    If Ret2 = False Then Exit Sub
    
     '~~> Get the 3rd File
    Ret3 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "MB5B Opening Stock")
    If Ret3 = False Then Exit Sub
    
        '~~> Get the 4th File
    Ret4 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "MB5B Closing Stock")
    If Ret4 = False Then Exit Sub
    
           '~~> Get the 5th File
    Ret5 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Masterdata")
    If Ret5 = False Then Exit Sub
    
     
    'Change name and open workbooks
     Set wb1 = Workbooks.Open(Ret1)
    wb1.Sheets(1).copy wb1.Sheets(1)
    ActiveSheet.Name = "ZR141 Opening Stock"
        
    Set wb2 = Workbooks.Open(Ret2)
    wb2.Sheets(1).copy wb1.Sheets(2)
    ActiveSheet.Name = "ZR141 Closing Stock"
    wb2.Close savechanges:=False
  
    Set wb3 = Workbooks.Open(Ret3)
    wb3.Sheets(1).copy wb1.Sheets(3)
    ActiveSheet.Name = "MB5B Opening Stock"
    wb3.Close savechanges:=False
    
    Set wb4 = Workbooks.Open(Ret4)
    wb4.Sheets(1).copy wb1.Sheets(4)
    ActiveSheet.Name = "MB5B Closing Stock"
    wb4.Close savechanges:=False
    
    Set wb5 = Workbooks.Open(Ret5)
    wb5.Sheets(1).copy wb1.Sheets(5)
    ActiveSheet.Name = "Masterdata"
    wb5.Close savechanges:=False
      
    Set wb2 = Nothing
    Set wb3 = Nothing
    Set wb4 = Nothing
    Set wb5 = Nothing
    Set wb1 = Nothing
    Set wb6 = Nothing
    
   End Sub

Betrifft: AW: VBA - finde den Fehler nicht von: Rudi Maintaire
Geschrieben am: 29.08.2014 10:50:56

Hallo,
Habe den Fehler nicht mehr.
dafür einen anderen.

Was soll der Blödsinn?

     Set wb1 = Workbooks.Open(Ret1)
    wb1.Sheets(1).copy wb1.Sheets(1)
    ActiveSheet.Name = "ZR141 Opening Stock"

Zu deutsch: öffne ein WB und kopiere dessen erstes Blatt auf dessen erstes Blatt.

Gruß
Rudi

Betrifft: AW: VBA - finde den Fehler nicht von: D.Hensel
Geschrieben am: 29.08.2014 11:01:12

Hallo Rudi, habe das dann später auch bemerkt und versucht zu korrigieren.
Kopiere nun wb2-wb6, da wb1 ja das Activeworkbook ist. Kriege aber wieder den selben Fehler wie ganz am Anfang. Automation error, direkt bei dem Part: 'Change name and open workbooks
Set wb2 = Workbooks.Open(Ret2)

Sub ImportFiles()
    ChDrive "X"
    ChDir "X:\Test"
       
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wb5 As Workbook,  _
wb6 As Workbook
    Dim Ret1, Ret2, Ret3, Ret4, Ret5
    Set wb1 = ActiveWorkbook
    
    '~~> Get the first File
    Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Opening Stock ZR141")
    If Ret1 = False Then Exit Sub

    '~~> Get the 2nd File
    Ret2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Closing Stock ZR141")
    If Ret2 = False Then Exit Sub
    
     '~~> Get the 3rd File
    Ret3 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "MB5B Opening Stock")
    If Ret3 = False Then Exit Sub
    
        '~~> Get the 4th File
    Ret4 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "MB5B Closing Stock")
    If Ret4 = False Then Exit Sub
    
           '~~> Get the 5th File
    Ret5 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Masterdata")
    If Ret5 = False Then Exit Sub
    
      
    'Change name and open workbooks
    Set wb2 = Workbooks.Open(Ret2)
    wb2.Sheets(1).copy wb1.Sheets(1)
    ActiveSheet.Name = "ZR141 Closing Stock"
    wb2.Close savechanges:=False
  
    Set wb3 = Workbooks.Open(Ret3)
    wb3.Sheets(1).copy wb1.Sheets(2)
    ActiveSheet.Name = "MB5B Opening Stock"
    wb3.Close savechanges:=False
    
    Set wb4 = Workbooks.Open(Ret4)
    wb4.Sheets(1).copy wb1.Sheets(3)
    ActiveSheet.Name = "MB5B Closing Stock"
    wb4.Close savechanges:=False
    
    Set wb5 = Workbooks.Open(Ret5)
    wb5.Sheets(1).copy wb1.Sheets(4)
    ActiveSheet.Name = "Masterdata"
    wb5.Close savechanges:=False
    
    Set wb6 = Workbooks.Open(Ret1)
    wb6.Sheets(1).copy wb1.Sheets(5)
    ActiveSheet.Name = "ZR141 Opening Stock"
    
    Set wb2 = Nothing
    Set wb3 = Nothing
    Set wb4 = Nothing
    Set wb5 = Nothing
    Set wb1 = Nothing
    Set wb6 = Nothing
    
   End Sub

Betrifft: AW: VBA - finde den Fehler nicht von: Rudi Maintaire
Geschrieben am: 29.08.2014 11:11:04

Hallo,
versuchs mal so:

Sub ImportFiles()
  ChDrive "x"
  ChDir "x:\Makro Test"
  
  Dim wb As Workbook, wbAkt As Workbook
  Dim Ret(1 To 5)
  Dim i As Integer
  Dim sNames
  sNames = Array("", "ZR141 Opening Stock", "ZR141 Closing Stock", _
                     "MB5B Opening Stock", "MB5B Closing Stock", _
                     "MasterData")
  Set wbAkt = ActiveWorkbook
  For i = 1 To 5
    '~~> Get the FileNames
    Ret(i) = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
      , sNames(i))
    If Ret(i) = False Then Exit Sub
  Next i
  For i = 1 To 5
    'Change name and open workbooks
    Set wb = Workbooks.Open(Ret(i))
    wb.Worksheets(i).Copy wbAkt.Worksheets(i)
    ActiveSheet.Name = sNames(i)
    wb.Close False
  Next i
  
End Sub

Gruß
Rudi

Betrifft: AW: VBA - finde den Fehler nicht von: D.Hensel
Geschrieben am: 29.08.2014 11:16:44

Vielen Dank für die Mühe. Habe den selben Fehler bei

  wb.Worksheets(i).copy wbAkt.Worksheets(i)

Er öffnet (wie bei meiner Version auch) die 1. Datei aber schon das umbennen scheitert. Die zweite wird gar nicht erst geöffnet.

Automation error (selber Fehler wie oben)

VG

Betrifft: AW: VBA - finde den Fehler nicht von: Rudi Maintaire
Geschrieben am: 29.08.2014 11:30:36

Hallo,
kleiner Fehler.

  For i = 1 To 5
    'Change name and open workbooks
    Set wb = Workbooks.Open(Ret(i))
    wb.Worksheets(1).Copy wbAkt.Worksheets(i)
    ActiveSheet.Name = sNames(i)
    wb.Close False
  Next i

Ansonsten läuft der Code bei mir durch.
Gruß
Rudi

Betrifft: AW: VBA - finde den Fehler nicht von: D.Hensel
Geschrieben am: 29.08.2014 11:34:41

Habe i mit 1 ersetzt und kriege wieder den Automation error. (selbe Stelle) So langsam bin ich am verzweifeln.

Sub TestMerge()
  ChDrive "x"
  ChDir "X:\Test"
  
  Dim wb As Workbook, wbAkt As Workbook
  Dim Ret(1 To 5)
  Dim i As Integer
  Dim sNames
  sNames = Array("", "ZR141 Opening Stock", "ZR141 Closing Stock", _
                     "MB5B Opening Stock", "MB5B Closing Stock", _
                     "MasterData")
  Set wbAkt = ActiveWorkbook
  For i = 1 To 5
    '~~> Get the FileNames
    Ret(i) = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
      , sNames(i))
    If Ret(i) = False Then Exit Sub
  Next i
  For i = 1 To 5
    'Change name and open workbooks
    Set wb = Workbooks.Open(Ret(i))
    wb.Worksheets(1).copy wbAkt.Worksheets(i)
    ActiveSheet.Name = sNames(i)
    wb.Close False
  Next i

End Sub

Betrifft: da kann ich auch nicht helfen von: Rudi Maintaire
Geschrieben am: 29.08.2014 12:21:25

Hallo,
wie schon gesagt: läuft bei mir.

Gruß
Rudi

Betrifft: AW: da kann ich auch nicht helfen von: D.Hensel
Geschrieben am: 29.08.2014 12:50:15

Danke schonmal für die Hilfe. Habe ein Macro namens copy gehabt und dies gelöscht und dann gings. Als ich dann erneut probiert hab das zum laufen zu bringen, kam wieder dieser Fehler. Bei Arbeitskollegen funktioniert es.
Am Code sollte es nicht liegen

Betrifft: AW: da kann ich auch nicht helfen von: Daniel
Geschrieben am: 29.08.2014 13:42:45

Habe ein Macro namens copy gehabt

Man sollte eigenen Makros, Funktionen oder Variablen keine Namen geben, die von Excel oder VBA bereits verwendet werden.
es geht zwar prinzipell, aber du hast keine Kontrolle darüber, ob das Makro jetzt die originäre VBA-Funktion oder dein selbstgeschriebenes Makro verwendet.

Wenn man mit "ActiveSheet" oder "ActiveOject" arbeitet, muss man zusätzlich bei der gleichzeitigen Verwendung von selbstgeschriebenen Makros, die zwischendrin aufgerufen werden, darauf achten, ob die nicht zwischendrin die Selektion verändern oder andere Sheets oder Mappen aktivieren und dann das "ActiveSheet"/"ActiveWorkbook" auf das falsche Objekt verweist.

Gruß Daniel

Betrifft: AW: da kann ich auch nicht helfen von: D.Hensel
Geschrieben am: 29.08.2014 13:49:20

Danke Daniel, genau hier liegt auch der Fehler bei mir wahrscheinlich. Wenn ich das Macro aus meinem privaten Macro Workbook rauskopiere in ein Macro Workbook funtkioniert alles.
Problem gelöst, Danke euch allen.