Microsoft Excel

Herbers Excel/VBA-Archiv

Dateien öffnen bearbeiten schliessen | Herbers Excel-Forum


Betrifft: Dateien öffnen bearbeiten schliessen von: Hanspeter
Geschrieben am: 13.10.2008 21:06:28

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

  

Betrifft: AW: Dateien öffnen bearbeiten schliessen von: Tino
Geschrieben am: 13.10.2008 22:19:06

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


  

Betrifft: AW: Dateien öffnen bearbeiten schliessen von: Hanspeter
Geschrieben am: 14.10.2008 07:58:17

Hallo Tino,

funktioniert bestens!

Vielen Dank

Hanspeter


  

Betrifft: AW: Dateien öffnen bearbeiten schliessen von: Hanspeter
Geschrieben am: 14.10.2008 20:45:17

Hallo Tobi,
jetzt habe ich doch noch einen Nachbrenner, die „Automatik“ funktioniert perfekt. Was ich allerdings nicht berücksichtigt hatte, das es [wenn]-Abfragen auf verschiedene andere Tabellenblätter der Arbeitsmappe gibt. Wenn jetzt das Blatt gelöscht wird, und das Neue eingefügt wird, steht in allen Zellen, welche eine Formel enthalten ##########..Gehe ich dann manuell auf die Zelle, drücke F2 und Return, ist die Verknüpfung wieder ?aktualisiert? und der richtige Wert wird angezeigt.

Gibt es da auch eine Lösung?

Viele Grüße

Hanspeter


  

Betrifft: AW: Dateien öffnen bearbeiten schliessen von: Tino
Geschrieben am: 14.10.2008 21:13:00

Hallo,
dazu fällt mir nur eins ein.
Anstatt der Tabelle, kopieren wir die Zellen in die vorhandene Tabelle.

Modul Modul1

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 




Gruß Tino


Beiträge aus den Excel-Beispielen zum Thema "Dateien öffnen bearbeiten schliessen"