Makro Hilfe

[steve1da]

Hola,

zur Info.

http://ms-office-forum.net/forum/showthr...p?t=335310

Gruß,
steve1da

[WillWissen]

Hi Markus,

bitte nimm die Hinweise (auch im Nachbarforum) ernst. Lies dir dazu mal diesen Beitrag durch: http://www.clever-excel-forum.de/thread-3037.html

[Markus.Jens]

So war das nicht gemeint. Habe es zur Kenntnis genommen und war unabsichtlich. Versuche nur überall Infos herzubekommen. Schreibe in das andere Forum nicht mehr. Bleibe bei diesen. Tut mir leid an Alle. Sorry

[Kuwer]

Hallo Markus,

teste es jetzt noch mal mit dem Dateienholen:

Sub zustel()

 Dim strDatnam As String

 Dim strPatnam As String

 strPatnam = "C:\Users\MARMUE4\Desktop\STD\"

 strDatnam = Dir(strPatnam & "*.xlsx")

 Application.ScreenUpdating = False

 Do While Len(strDatnam)

   If strDatnam <> ThisWorkbook.Name Then

     With Workbooks.Open(strPatnam & strDatnam)

       .Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

       ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = strDatnam

       .Close savechanges:=False

     End With

     strDatnam = Dir

   End If

 Loop

 Application.ScreenUpdating = True

End Sub

Mit den Diagrammen solltest Du ein neues Thema beginnen, am Besten mit einem Beispiel.

Gruß Uwe

[Markus.Jens]

Hallo, leider funktioniert es immer noch nicht. Er zeigt wieder die gleiche Fehlermeldung bei der gleichen Zeile.

[Markus.Jens]

Sub MWSheetsAusMehrerenDateienEinlesen()
   Dim oTargetBook As Object
   Dim oSourceBook As Object
   Dim sPfad As String
   Dim sDatei As String

     Application.ScreenUpdating = False 'Das "Flackern" ausstellen
     Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen

     'Schritt 1: Arbeitsmappe festlegen, in die die neuen Sheets eingefügt werden...
     Set oTargetBook = ActiveWorkbook

     'Wichtiger Hinweis: Die Arbeitsblätter dürfen nicht vorhanden sein!
     'Alternativer Umbau: Löschen evtl. bereits vorhandener Arbeitsblätter

     'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
     sPfad = "F:\xls makro"
     sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien

     Do While sDatei <> ""

         'Schritt 3: öffnen der Datei und Datenübertragung
         Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen

         'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
         oSourceBook.Sheets(1).Copy after:=oTargetBook.Sheets(oTargetBook.Sheets.Count)

         'Es wird versucht den Dateinamen als Arbeitsblattnamen zu setzen.
         'Ist dieser bereits vorhanden wird der Fehler abgefangen und das neue Blatt
         'bekommt keinen anderen Namen und behält den typischen Namen Tabelle x
         On Error Resume Next

         'Arbeitsblattname wird der Dateiname
         oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = sDatei

         'Wenn ein Fehler aufgetreten ist, wird dieser resettet
         If Err.Number <> 0 Then
            Err.Number = 0
            Err.Clear
         End If
         On Error GoTo 0

         'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
         oSourceBook.Close False 'nicht speichern

         'Nächste Datei
         sDatei = Dir()

     Loop

     Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
     Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen

     'Kleine finale Fertig-Meldung
     MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"

     'Variablen aufräumen
     Set oTargetBook = Nothing
     Set oSourceBook = Nothing

End Sub
 

Dieser Makro funktioniert aber überträgt keine Daten in Meine Arbeitsmappe, diese bleibt leer?

[Kuwer]

Hallo,

Hallo, leider funktioniert es immer noch nicht. Er zeigt wieder die gleiche Fehlermeldung bei der gleichen Zeile.

probiere es noch mal, habe den Code geändert.

Gruß Uwe