Excel 2003 Inhalte einfügen

Dieses Thema Excel 2003 Inhalte einfügen im Forum "Microsoft Office Suite" wurde erstellt von joergi78, 17. Aug. 2005.

Thema: Excel 2003 Inhalte einfügen Ein Hallo an alle eifrigen Helfer, ich möchte den Inhalt von ca. 40 Exceldatein in eine neue Tabelle einfügen. Dazu...

  1. Ein Hallo an alle eifrigen Helfer,

    ich möchte den Inhalt von ca. 40 Exceldatein in eine neue Tabelle einfügen.
    Dazu ist zu sagen, das von den Tabellen alles bis auf die erste Zeile jeder Tabelle in die neue Tabelle eingefügt werden muss. Aber nur die Werte. Kann man dafür ein Makro schreiben? Dies würde meine Arbeit wesentlich vereinfachen, da ich diese Aufgabe jeden Monat mit neuen Tabellen machen muss. Ich hoffe ihr könnt mir helfen.

    mfg
    Jörgi
     
  2. Hallo joergi78,

    das kann man erstellen  ;D

    Einige Punkte sind vorher zu klären:

    bzgl. Ziel-Datei:
    a) soll die neue Datei unter einem festen Pfad gespeichert werden

    b) soll die Datei immer mit gleichem Namen gespeichert werden oder eine Datums-Erweitung im Namen tragen

    bzgl Quell-Dateien:
    c) Kann die Konstruktion so erfolgen, daß in einem Verzeichnis alle 40 Dateien liegen oder soll eine Möglichkeit vorhanden sein, 40 verschiedene Quellpfad/Quelldateien an´zugeben.

    d) Sollen die Blätter der Dateien mit Namen übertragen werden ?
    Wenn ja sind die Blattnamen eindeutig oder gibt es doppelte ?
    Wenn es doppelte gibt, wie soll dann der Blattname erweitert werden ?

    Gruß Matjes :)
     
  3. Hallo Matjes,
    also deine Antwort hört sich ja schon mal vielversprechend an.
    Nun zu deinen Fragen:
    a)ja, die Datei wird immer unter einem festen Pfad gespeichert.

    b)die Datei wird immer unter den gleichen Namen gespeichert, enthält aber jeden Monat neu die Angaben Monat und Jahr.
    Die Zieldatei heißt also z.B.:
    Hamburg082005Container.xls
    wobei 08=August 2005=Jahr
    kann also auch092005, 102005 usw. heißen

    c)die 40 Quelldateien liegen alle in einem Verzeichniss

    d)wenn es geht, sollen die Blätter alle mit Namen übertragen werden. Die Namen sind eindeutig, haben aber auch jeden Montat die Änderung von Monat und eventuell Jahr. Doppelte Namen gibt es nicht.

    ich hoffe die Daten helfen Dir mir zu helfen.
    Die Werte kommen aber alle in eine Mappe einer Tabelle. Die Dateinamen der Quelldateien sollen jeweils eine Zeile über den einzufügenden Werten erscheinen.
    Ich hoffe das geht.
     
  4. Kleiner Einwurf:
    Ich habe auch viele Dateien, die jeden Monat neu erstellt werden. Zur besseren Übersicht und auch, um sie besser sortieren zu können, kriegen sie immer Dateinemen in folgender Form:
    Hamburg_Container_2005-08.xls
    Also Datum ganz am Ende des Dateinamens und zuerst das Jahr, dann den Monat (wenn nötig auch den Tag ganz am Ende).
    Auch immer mit einem Bindestrich (es kann auch ein Unterstrich sein) zwischen den einzelnen Zahlen. Eine Zahlenwurscht wie 20050818 ist schon arg unübersichtlich.
     
  5. Hi zusammen,

    @klexy:
    Da hast du natürlich vollkomme Recht  ;D

    Wer schon mal eine Datei in einem Ordner gesucht hat, der 365 Dateien enthält, und sich die Dateinamen nur durch das Datum im Namen unterscheiden, kann deinen Rat gut nachvollziehen.  ;D  ;D  ;D

    @joergi
    Wenn man aber alle Dateien eines Jahres jeweils in einem Ordner speichert, behält man auch so die Übersicht.

    Jetzt noch zum Makro:
    Die Pfade für Quell- und Ziel-Pfad müssen angepasst werden.

    Dann viel Spaß damit und wenn Du dann Freitags fürher Feierabend machen kannst, denk an Wintotal.  ;D  ;D  ;D

    Gruß matjes :)
    Code:
    Option Explicit
    '********************************************************************************
    '*** Mit dem Makro werden die Blätter ALLER Excel-Dateien
    '*** im QUELLVERZEICHNIS in EINE Excel-Mappe im ZIELVERZEICHNIS kopiert
    '***
    '*** Das kopieren der Blätter erfolgt über->Inhalte einfügen->Werte'
    '*** Kopiert wird jeweils das ganze Blatt bis auf die erste Zeile
    '*** Die Blattnamen werden mit übertragen und müssen deshalb eindeutig sein.
    '*** (Bei einem Konflikt wird das Blatt Fehler xxx benannt)
    '***
    '*** Für die Namensgebung der Zieldatei werden Monat und Jahr abgefragt.
    '***
    '*** Für die Zieldatei kann ein Template definiert werden
    '***
    '********************************************************************************
    
    '!!!!!!!'!!! PFADE & NAMEN ANPASSEN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    Const c_myQUELLPFAD = D:\Test_Container\Input
    Const c_myZIELPFAD = D:\Test_Container\Output
    Const c_ZIELDATEI_Teil1 = Hamburg
    Const c_ZIELDATEI_Teil2 = Container.xls
    
    'Vorlage für Zieldatei
    Const c_XLTEMPLATE = D:\Test_Container\Templates\Vorlage_HamburgContainer.xls
    'wenn ohne Template gearbeitet werden soll
    'Const c_XLTEMPLATE = 
    '### geändert 19.8.2005
    
    '!!!!!!!'!!! PFADE & NAMEN ANPASSEN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    
    Sub DerGrosseSammlerFuerJoergi()
    
      Dim s_Monat As String, s_Jahr As String
      Dim s_ZielFilenameFull As String, s_ZielFilename As String
      Dim wbz As Workbook, wsz_leer As Worksheet
      Dim x As Long
    
      Application.ScreenUpdating = False
    
     ->Quellpfad prüfen
      If Not PfadPruefen(c_myQUELLPFAD) Then
        MsgBox (Quellpfad nicht vorhanden. & vbLf & c_myQUELLPFAD)
        GoTo AUFRAEUMEN
      End If
      
     ->Zielpfad prüfen
      If Not PfadPruefen(c_myZIELPFAD) Then
        MsgBox (Zielpfad nicht vorhanden. & vbLf & c_myZIELPFAD)
        GoTo AUFRAEUMEN
      End If
      
     ->### geändert 19.8.2005
     ->Template prüfen
      If Not ZieldateiPruefen(c_XLTEMPLATE) Then
        MsgBox (Template für Zieldatei nicht vorhanden. & vbLf & c_XLTEMPLATE)
        GoTo AUFRAEUMEN
      End If
    
     ->Eingabe Monat
      Call EingabeDateinameMonat(s_Monat)
      If s_Monat =  Then GoTo AUFRAEUMEN
      
     ->Eingabe Jahr
      Call EingabeDateinameJahr(s_Jahr)
      If s_Jahr =  Then GoTo AUFRAEUMEN
      
     ->Zieldateiname
      s_ZielFilename = c_ZIELDATEI_Teil1 & s_Monat & s_Jahr & c_ZIELDATEI_Teil2
      s_ZielFilenameFull = c_myZIELPFAD & Application.PathSeparator & s_ZielFilename
      
     ->Zieldateinamen prüfen
      If ZieldateiPruefen(s_ZielFilenameFull) Then
        MsgBox ( _
          Zieldateiname im Zielpfad bereits vorhanden. & vbLf & _
          s_ZielFilenameFull)
        GoTo AUFRAEUMEN
      End If
      
     ->### geändert 19.8.2005
     ->Neue Zieldatei anlegen
      If c_XLTEMPLATE =  Then
       ->ohne Template
        Set wbz = Workbooks.Add(Template:=xlWBATWorksheet)
      Else
       ->mit Template
        Set wbz = Workbooks.Add(Template:=c_XLTEMPLATE)
      End If
      
     ->Neue Zieldatei aufräumen
      Application.DisplayAlerts = False
      For x = wbz.Worksheets.Count To 2 Step -1
        wbz.Worksheets(x).Delete->Blätter löschen
      Next
      Application.DisplayAlerts = True
     ->letztes Blatt zum späteren löschen merken
      Set wsz_leer = wbz.Worksheets(1)
      
     ->Blätter der Quelldateien in Zieldatei kopieren
      If Not QuelldateiblaetterInZieldateiKopieren(wbz, c_myQUELLPFAD) Then
        wbz.Close SaveChanges:=False
        GoTo AUFRAEUMEN
      End If
      
     ->leeres Blatt löschen
      Application.DisplayAlerts = False
      wsz_leer.Delete
      Application.DisplayAlerts = True
      
     ->Zieldatei Speichern und schliessen
     ->### geändert 19.8.2005
      wbz.SaveAs Filename:=s_ZielFilenameFull, FileFormat:=xlWorkbookNormal
      wbz.Close SaveChanges:=False
      
    AUFRAEUMEN:
      Set wbz = Nothing: Set wsz_leer = Nothing
      Application.ScreenUpdating = True
    End Sub
    '********************************************************************************
    Private Function QuelldateiblaetterInZieldateiKopieren( _
          wbz As Workbook, s_QuellPfad As String) As Boolean
      
      Dim x As Long, wbq As Workbook
      
     ->Rückgabekennung -> FEHLER
      QuelldateiblaetterInZieldateiKopieren = False
    
     ->Quellfiles suchen
      With Application.FileSearch
        .NewSearch
        .LookIn = s_QuellPfad
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
         ->Alle gefunden Dateien nacheinander abarbeiten
          For x = 1 To .FoundFiles.Count
             ->Datei öffnen
              Workbooks.Open .FoundFiles(x)
              Set wbq = ActiveWorkbook
              
             ->Filenamen in der Statusbar ausgeben
              Application.StatusBar = _
                x & / & .FoundFiles.Count &    & .FoundFiles(x)
              
             ->Blätter kopieren
              Call KopierenDerBlaetter(wbq, wbz)
              
             ->Datei schliessen
              Application.DisplayAlerts = False
              wbq.Close SaveChanges:=False
              Application.DisplayAlerts = True
          Next x
         ->Rückgabekennung -> OK
          QuelldateiblaetterInZieldateiKopieren = True
        Else
          MsgBox Es wurden keine Quelldateien gefunden.
        End If
      End With
    AUFRAEUMEN:
      Application.StatusBar = 
      Set wbq = Nothing
    End Function
    '********************************************************************************
    Private Function KopierenDerBlaetter(wbq As Workbook, wbz As Workbook)
      Dim wsq As Worksheet, wsz As Worksheet
      Dim l_Fehler As Long, l_rows As Long, l_cols As Long
      
     ->Über alle Arbeitsblätter der Quell-Datei
      For Each wsq In wbq.Worksheets
        
     ->Zielblatt anlegen
     ->### geändert 19.8.2005
      wbz.Worksheets(1).Copy After:=wbz.Worksheets(wbz.Worksheets.Count)
      Set wsz = wbz.Worksheets(wbz.Worksheets.Count)
        
       ->Blattnamen übertragen
       ->(bei Fehler Ersatznamen)
        On Error Resume Next
        wsz.Name = wsq.Name
        If Err.Number <> 0 Then
          Err.Clear
          wsz.Name = xxx_FEHLERBLATTNAME_ & l_Fehler
          l_Fehler = l_Fehler + 1
          On Error GoTo 0
        End If
        On Error GoTo 0
        
       ->benutzten Bereich des Quellblattes kopieren
       ->(1. Zeile auslassen)
        l_rows = wsq.UsedRange.Row + wsq.UsedRange.Rows.Count - 1
        l_cols = wsq.UsedRange.Column + wsq.UsedRange.Columns.Count - 1
        wsq.Range(wsq.Cells(2, 1), wsq.Cells(l_rows, l_cols)).Copy
        
       ->Werte auf das Zielblatt kopieren
        wsz.Range(A1).PasteSpecial _
                  Paste:=xlValues, _
                  Operation:=xlNone, _
                  SkipBlanks:=False, _
                  Transpose:=False
        Application.DisplayAlerts = True
      Next
        
    AUFRAEUMEN:
      Set wsq = Nothing: Set wsz = Nothing
    End Function
    '********************************************************************************
    Private Function EingabeDateinameJahr(s_Jahr As String)
      
      s_Jahr = Format(Year(Now()), 0000)
      Do
        s_Jahr = InputBox( _
                  Bitte geben Sie das Jahr für den Zieldateinamen ein. & vbLf & _
                  Eingabe bitte vierstellig (z.B. 2005), _
                  Eingabe Jahr für Zieldateiname, _
                  s_Jahr)
        Select Case s_Jahr
          Case : Exit Do->Abbruch
          Case 2005, 2006, 2007, 2008, 2009: Exit Do->OK
          Case 2010, 2011, 2012, 2013, 2014: Exit Do->OK
          Case Else: MsgBox (Falsche Eingabe)
        End Select
      Loop
    End Function
    '********************************************************************************
    Private Function EingabeDateinameMonat(s_Monat As String)
      
      s_Monat = Format(Month(Now()), 00)
      Do
        s_Monat = InputBox( _
                  Bitte geben Sie den Monat für den Zieldateinamen ein. & vbLf & _
                  Eingabe bitte zweistellig (z.B. 07), _
                  Eingabe Monat für Zieldateiname, _
                  s_Monat)
        Select Case s_Monat
          Case : Exit Do->Abbruch
          Case 01, 02, 03, 04, 05, 06: Exit Do->OK
          Case 07, 08, 09, 10, 11, 12: Exit Do->OK
          Case Else: MsgBox (Falsche Eingabe)
        End Select
      Loop
    End Function
    '********************************************************************************
    Private Function PfadPruefen(s_Path As String) As Boolean
      If Dir(s_Path, vbDirectory) =  Then
        PfadPruefen = False
      Else
        PfadPruefen = True
      End If
    End Function
    '********************************************************************************
    Private Function ZieldateiPruefen(s_filenameFull As String) As Boolean
      If Dir(s_filenameFull) =  Then
        ZieldateiPruefen = False
      Else
        ZieldateiPruefen = True
      End If
    End Function
     
  6. also erstmal vielen dank.
    Ich werde das heute noch probieren und melde mich ob es geklappt hat oder nicht.

    mfg
    joergi78
     
  7. ;D
    super Matjes, das ganze hat fast funktioniert.
    Leider nur fast. Jetzt ist es nur noch, dass für jede Datei eine einzelne Excel Mappe angelegt wurde die dann von 1 bis 41 durchnummeriert ist. Kann man das ganze auch so machen, das alle Werte in

    eine einzelne Mappe
    eingetragen werden?
    Wenn es geht sogar in eine bestimmte Excel Vorlage???
    Das wäre aber nicht ganz so wichtigt. Den Arbeitsschritt kannn man ja auch per Hand erledigen.

    Aber trotzdem DANKE für die Hilfe
     
  8. Hallo joergi78,

    als die Möglichkeit ein Template für die Zieldatei anzugeben ist eingebaut
    (siehe oben Änderungskennung ### geändert 19.8.2005)

    Das hab ich nicht ganz verstanden. Meinst Du mit Mappe Blatt ?

    Und was heißt durchnummeriert. Die Blattnamen ? Wie lautet denn einer dieser duchnummerierten Blattnamen.

    'alle Werte in eine einzelne Mappe' - das müßtest Du etwas anschaulicher beschreiben.

    Gruß Matjes :)
     
  9. sorry, ich meine natürlich in ein Blatt.
    die Blätter werden so durchnummeriert:
    Tabelle1, Tabelle2, Tabelle3, Tabelle4 usw.
    wobei immer das erste Blatt einen Fehler enthalten muss. Es heißt immer
    xxx_FEHLERBLATTNAME_0
    und die Frage ist, kann ich die Werte in einer bestimmten Tabellenvorlage eintragen lassen?
     
  10. was meinst du denn mit:
    als die Möglichkeit ein Template für die Zieldatei anzugeben ist eingebaut
    das habe ich noch nicht ganz verstanden.
     
Die Seite wird geladen...

Excel 2003 Inhalte einfügen - Ähnliche Themen

Forum Datum
Excel 2003 - Kleines Problem mit einer Formel Microsoft Office Suite 25. Juni 2014
Office 2003 und 2010 Paralellinstallatin, mehrer xls-Dateien Excel 2003 zuweisen Windows XP Forum 13. Juli 2012
2 Spalten in Excel 2003 fixieren Microsoft Office Suite 28. Mai 2012
MS Excel 2003 ganze Zeilen löschen Microsoft Office Suite 1. Okt. 2011
Verlinkung nach Umstieg Excel 2003 auf 2007 Microsoft Office Suite 23. Mai 2011