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

Beiträge aus den Excel-Beispielen zum Thema "suchen-ersetzen in mehreren Dateien"