Dateien öffnen bearbeiten schliessen

Hallo zusammen,
ich such für folgendes Problem eine Lösung:
Ich habe ein Verzeichnis, dies heißt Gäste in diesem Verzeichnis sind 100-200 Arbeitsmappen mit je acht Tabellenblättern. Eines dieser Tabellenblätter trägt den Namen Einladung Dieses Tabellenblatt möchte ich nun durch ein anderes Tabellenblatt, welches ebenfalls Einladung heißt, ersetzen. Zu Fuß eine recht aufwendige Sache.
Gibt es nun eine Möglichkeit, eine Excelmappe zB.(Master.xls) mit einem Tabellenblatt Einladung, zu erstellen, in der ein Makro läuft, welches aus dem Verzeichnis Gäste die erste xls Datei öffnet, das Tabellenblatt Einladung löscht, und das neue Tabellenblatt Einladung (aus Master.xls) wieder einfügt, die Datei wieder abspeichert und die nächste Datei öffnet usw. bis alle Dateien geändert wurden?
Schönen Abend
Hanspeter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
teste mal diesen Code, Pfad musst Du noch anpassen, die Datei selbst kann sich auch im gleichen Verzeichnis befinden.
Modul Modul1

Option Explicit 
 
Sub ErsetzteTabelle() 
Dim strPath As String, strFile As String 
Dim Bereich As Range 
Dim NeueTab As Worksheet 
Dim objDatei As Workbook 
Dim iPos As Integer 
Dim meCalc As Integer 
Const Laufwerk As String = "C:\Gäste\"  ' Pfad anpassen! 
 
Set NeueTab = ThisWorkbook.Sheets("Einladung") 
 
  
    strFile = _
    Dir$(Laufwerk & "*.xls*") 
With Application 
 meCalc = .Calculation 
 .Calculation = xlCalculationManual 
 .EnableEvents = False 
 .ScreenUpdating = False 
 .DisplayAlerts = False 
     
    Do While strFile <> "" 
     If strFile <> ThisWorkbook.Name Then 
        Set objDatei = Workbooks.Open(Laufwerk & strFile, False) 
          
         With objDatei 
           iPos = .Sheets("Einladung").Index 
           iPos = IIf(.Sheets.Count < iPos, iPos - 1, iPos) 
           .Sheets("Einladung").Delete 
           NeueTab.Copy .Sheets(iPos) 
           .Close True 
         End With 
        Set objDatei = Nothing 
      End If 
     strFile = Dir$ 
     
    Loop 
 .Calculation = meCalc 
 .DisplayAlerts = True 
 .EnableEvents = True 
 .ScreenUpdating = True 
End With 
 
End Sub

Gruß Tino

Option Explicit Sub ErsetzteTabelle() Dim strPath As String, strFile As String Dim NeueRange As Range Dim objDatei As Workbook Dim meCalc As Integer Const Laufwerk As String = "C:\Dokumente und Einstellungen\ts\Eigene Dateien\Forum\ersetze\" ' "C:\Gäste\" ' Pfad anpassen! Set NeueRange = ThisWorkbook.Sheets("Einladung").Cells strFile = _ Dir$(Laufwerk & "*.xls*") With Application meCalc = .Calculation .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False .DisplayAlerts = False Do While strFile <> "" If strFile <> ThisWorkbook.Name Then Set objDatei = Workbooks.Open(Laufwerk & strFile, False) With objDatei NeueRange.Copy objDatei.Sheets("Einladung").Range("A1") .Close True End With Set objDatei = Nothing End If strFile = Dir$ Loop .Calculation = meCalc .DisplayAlerts = True .EnableEvents = True .ScreenUpdating = True End With End Sub

Beliebteste Forumthreads (12 Monate)

Dateien öffnen bearbeiten schliessen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread