Verknüpfungen ändern

Sub ersetzen() Dim Ws As Worksheet With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With For Each Ws In ThisWorkbook.Worksheets Ws.Range("A5:Z100").Replace "Muster", Ws.Name Next Ws End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Boris!
Der Code ist ungetested, sollte aber funzen!

Sub ersetzen()
Dim Ws As Worksheet
Dim n As Long, m As Integer
Dim arr As Variant
Dim fSearch As FileSearch
Dim wkb As Workbook
Dim strPath As String
Dim iCnt As Integer
On Error GoTo ERRORHANDLER
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With
strPat = "D:\Alle"
Set fSearch = Application.FileSearch
With fSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeExcelWorkbooks
.Execute
   For iCnt = 1 To .FoundFiles.Count

   Set wkb = Workbooks.Open(.FoundFiles(iCnt))

      For Each Ws In wkb.Worksheets

         arr = Ws.Range("A5:Z100").Formula

            For m = 1 To UBound(arr, 2)
               For n = 1 To UBound(arr, 1)
                  arr(n, m) = Replace(arr(n, m), "Muster", Ws.Name)
               Next
            Next

         Ws.Range("A5:Z100").Formula = arr

      Next

   wkb.Close True

   Next
End With
ERRORHANDLER:
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
End Sub

Gruß Sepp

Hallo Boris!
Da hab' ich dich falsch verstanden!
Dann so:

Sub ersetzen()
Dim Ws As Worksheet
Dim n As Long, m As Integer
Dim arr As Variant
On Error GoTo ERRORHANDLER
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With

      For Each Ws In ThisWorkbook.Worksheets

         arr = Ws.Range("A5:Z100").Formula

            For m = 1 To UBound(arr, 2)
               For n = 1 To UBound(arr, 1)
                  arr(n, m) = Replace(arr(n, m), "Muster", Ws.Name)
               Next
            Next

         Ws.Range("A5:Z100").Formula = arr

      Next

ERRORHANDLER:
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
End Sub

Gruß Sepp

Sub verknuepfungen_ersetzen() Dim arr As Variant, n As Long, m As Long Dim Ws As Worksheet On Error GoTo ERRORHANDLER With Application .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False For Each Ws In ThisWorkbook.Worksheets arr = Ws.Range("A5:Z100").Formula For m = 1 To UBound(arr, 2) For n = 1 To UBound(arr, 1) arr(n, m) = WorksheetFunction.Substitute(arr(n, m), "Muster", Ws.Name) Next Next Ws.Range("A5:Z100").Formula = arr Next Ws ERRORHANDLER: .Calculation = xlCalculationAutomatic .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With End Sub

Sub Boris() With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With ActiveWorkbook.Sheets.Select Cells.Select Selection.Replace "BORIS", ActiveSheet.Name ActiveCell.Select ActiveSheet.Select With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With End Sub

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Verknüpfungen ändern

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread