Herbers Excel-Forum - das Archiv

suchen-ersetzen in mehreren Dateien

Bild

Betrifft: suchen-ersetzen in mehreren Dateien
von: Pascal

Geschrieben am: 14.03.2005 16:47:57
Liebe LeserInnen,
Habe viele ähnliche xls-Dateien, in welchen ich eine bestimmte Überschrift ändern möchte. Die Dateien sind geordent, allerdings in verschiedenen Ordnern. Aber alle Ordner befinden sich wiederum in ein und demselben Ordner.
Wie kann ich nun die bestimmte Spaltenüberschrift bei allen Dateien ändern?
Danke für die Hilfe!
mfg Pascal
Bild

Betrifft: AW: suchen-ersetzen in mehreren Dateien
von: marcl

Geschrieben am: 15.03.2005 08:26:53
Hallo Pascal,
Habe 2 Makros für Dich, die ich mal von Ramses bekam und ein wenig geändert habe.
Sub Write_All_ExcelFiles_in_worksheet()
' listet Dir alle Dateien in Unterordnern als Hyperelink auf
Application.ScreenUpdating = False
'by Ramses
Dim Dateiform As String, myStr As String
Dim geffile As String
Dim i As Long, totFiles As Long, chkHype As Integer
Dim oldStatus As Variant
Application.ScreenUpdating = True
oldStatus = Application.StatusBar
On Error GoTo myErrHandler
Dateiform = "*.xls" ' zu suchende Dateiform
If Dateiform = "" Then
Application.ScreenUpdating = True
Exit Sub
End If
With Application.FileSearch
.LookIn = "H:\Eigene Dateien" 'Dein Ordnerpfad, wo die Unterordner drinn sind
.SearchSubFolders = True 'True für Suche in allen Unterverzeichnissen!!
.Filename = Dateiform
If .Execute() > 0 Then
totFiles = .FoundFiles.Count
Application.StatusBar = "Total " & totFiles & " in " & mySpace & " gefunden "
For i = 1 To .FoundFiles.Count
geffile = .FoundFiles(i)
'In Tabelle eintragen
Cells([A65536].End(xlUp).Row + 1, 1) = geffile
ActiveSheet.Hyperlinks.Add Anchor:=Cells([A65536].End(xlUp).Row, 1), Address:=geffile _
, TextToDisplay:=geffile
Selection.Font.ColorIndex = 2
Next i
End If
End With
ErrEntry:
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
MyExit:
Close #1
Exit Sub
myErrHandler:
Select Case err
Case 71
myStr = myStr & "Datenträger nicht bereit"
End Select
Resume ErrEntry
'Call umbenennen   ' lieber serstmal bis hier laufen lassen und dann Tabelle nachsehen
End Sub

Sub umbenennen()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("a1").Select
For i = 1 To 90000
zell = ActiveCell.Address
Range(zell).Offset(1, 0).Select
pfadname = ActiveCell
Workbooks.Open Filename:=pfadname 'Öffnet jede Datei in der Liste
On Error GoTo err
Dim Sh As Worksheet
For Each Sh In Worksheets ' mit jedem Blatt in der Datei
Sh.Activate
Range("A1") = "Deine Überschrift"  ' Deine Überschrift in Zelle A1 eintragen
ActiveWorkbook.Save
ActiveWorkbook.Close
Next Sh
Next i
Exit Sub
err:
Application.Quit
End Sub

Wenn Du das Hochkomma vor call wegnimmst, laufen beide Makros nacheinander.
Gruß
Marcl
 Bild
Excel-Beispiele zum Thema "suchen-ersetzen in mehreren Dateien"
Druck aus mehreren Tabellenblättern auf eine Druckseite Daten von mehreren Blättern auf ein Druckblatt
Werte in mehreren Spalten sortieren Den selben Bereichsnamen in mehreren Tabellenblättern
Tabelle nach mehreren Kriterien summieren Auswahl von Zellen in mehreren Zeilen verhinden
Wert von einer Zelle zur anderen in mehreren Tabellen übernehmen Benannte Bereich aus mehreren Arbeitsmappen importieren
Filtern über VBA nach mehreren Kriterien Kosten nach mehreren Kriterien erfassen