Arbeitsmappe per Makro in mehrere Datein kopieren

Dieses Thema Arbeitsmappe per Makro in mehrere Datein kopieren im Forum "Windows XP Forum" wurde erstellt von joergi78, 23. Sep. 2010.

Thema: Arbeitsmappe per Makro in mehrere Datein kopieren Hallo an alle, ist es möglich eine Arbeitsmappe aus Tabelle 1 (Excel2003) in alle Exceldateien eines Ordners zu...

  1. Hallo an alle,

    ist es möglich eine Arbeitsmappe aus Tabelle 1 (Excel2003) in alle Exceldateien eines Ordners zu kopieren und ans Ende zu stellen?
    Wäre mir eine große Hilfe.

    Gruß joergi78
     
  2. Hallo joergi78,

    ich hab dir mal einen Prototypen zusammengestrickt.
    Pfad mußt du noch anpassen.


    Gruß Matjes :)
    Code:
    Option Explicit
    '<<< A N P A S S E N >>>
    Private Const c_VERZEICHNIS = D:\00_TestExcel
    Private Const c_APPENDIX = .xls
    '<<< A N P A S S E N  E N D E >>>
    
    Sub Excel_Makro_AktivesBltInAlleXLSEinesVerzKopieren()
     
    ->Dateien im Verzeichnis feststellen
     Dim ws As Worksheet, wb As Workbook
     Dim fso As Object, fDir As Object, fFiles As Object, fFile As Object
     Dim sName As String
     Dim bGeoeffnet As Boolean
     
    ->zu kopierendes Arbeitsblatt setzen
     Set ws = ThisWorkbook.ActiveSheet
     
     Set fso = CreateObject(Scripting.FileSystemObject)
     Set fDir = fso.GetFolder(c_VERZEICHNIS)
     Set fFiles = fDir.Files
     For Each fFile In fFiles
      sName = fFile.Name
     ->Name ungleich eigener Name
      If ThisWorkbook.Name <> sName Then
      ->Arbeitsmappe .xls ?
       If LCase(Right(fFile.Name, Len(c_APPENDIX))) = LCase(c_APPENDIX) Then
        
       ->prüfen, ob Datei bereits geöffnet
        bGeoeffnet = False
        For Each wb In Workbooks
         If wb.Name = sName Then bGeoeffnet = True: Exit For
        Next
        
       ->Arbeitsmappe öffnen, wenn noch nicht geoeffnet
        If Not bGeoeffnet Then
         Set wb = Nothing
         On Error Resume Next
         Set wb = Workbooks.Open(c_VERZEICHNIS & Application.PathSeparator & sName)
         On Error GoTo 0
        End If
        
        If wb Is Nothing Then
         MsgBox Datei konnte nicht geöffnet werden:  & vbLf & vbLf & sName
        Else
        ->Blatt kopieren
         ws.Copy After:=wb.Worksheets(wb.Worksheets.Count)
         
        ->war Datei geöffnet ?
         Application.DisplayAlerts = False
         If bGeoeffnet Then
         ->Datei speichern
          wb.Save
         Else
         ->Datei schliessen mit Speichern
          wb.Close Savechanges:=True
         End If
         Application.DisplayAlerts = True
        End If
       End If
      End If
     Next
    
    AUFRAEUMEN:
     Set ws = Nothing: Set wb = Nothing
     Set fso = Nothing: Set fDir = Nothing: Set fFiles = Nothing: Set fFile = Nothing
    End Sub
     
Die Seite wird geladen...

Arbeitsmappe per Makro in mehrere Datein kopieren - Ähnliche Themen

Forum Datum
Hintergrund-Designs für Excel- oder Word-Arbeitsmappen? Windows XP Forum 28. Juni 2010
Fehlermeldung in Excel: Diese Arbeitsmappe hat ihr VBA Projekt... Microsoft Office Suite 17. Okt. 2007
Excel 2003 - Einstellungen in freigegebenen Arbeitsmappen Windows XP Forum 21. Juni 2006
Fusszeile für gesammte Arbeitsmappe über Macro Microsoft Office Suite 12. Mai 2006
Arbeitsmappen verbinden Windows XP Forum 15. Feb. 2006