Indsæt bestemt værdi i samtlige regneark/arkfaner i biblioteket

Jep, jeg kan godt følge dig, den slags opgaver har jeg lavet flere.

Du skal vide et eller anet specifikt omkring de filer du vil opdatere... lettes ville det være at kende arkfanenavnet...

Hvad har du konkret at gå efter, som kan identificere det sted du skal opdatere?

Hej Flemming

ThisWorkbook.Path benytter jeg til at bestemme/angive hvor filerne filerne ligger, de enkelte arkfaner havde jeg tænkt mig at få adgang til hed hjælp af

For each WS .... next  ...

men hvordan indlæser jeg de ukendte regneark og gennemløber arkfanerne automatisk

Private Sub CommandButton1_Click()
Dim OK As Boolean, I As Integer
Sti = ThisWorkbook.Path

Set Fil = Application.FileSearch
With Application.FileSearch
    .LookIn = Sti
    .FileType = msoFileTypeExcelWorkbooks
    For FundetFiler = 1 To .FoundFiles.Count
        NyWorkbook = .FoundFiles(FundetFiler)
        If Right(NyWorkbook, Len(ThisWorkbook.Name)) <> ThisWorkbook.Name Then
            ReDim MyWorkbook(1)
            P = 1
            For Each ws In ThisWorkbook.Worksheets
                MyWorkbook(P - 1) = ws.Name
                ReDim Preserve MyWorkbook(P)
                P = P + 1
            Next
            Workbooks.Open Filename:=NyWorkbook
            ActiveSheet.Select
            For Each ws In Worksheets
                OK = False
                For I = 1 To UBound(MyWorkbook)
                    If ws.Name = MyWorkbook(I) Then
                        OK = True
                    End If
                Next
                If OK = False Then
                    Sheets(ws.Name).Range("A1").Value = "Yes"
                End If
            Next
            ActiveWorkbook.Save
            ActiveWindow.Close
        End If
    Next
End With
End Sub

Ret lige selv
Sheets(ws.Name).Range("A1").Value = "Yes"
til
Sheets(ws.Name).Range("G6").Value = "Yes"

akyhne > den finder ikke nogen filer/regneark i mappen :o(

Prøv denne:

Private Sub CommandButton1_Click()
Dim FS As FileSearch
Dim FilePath As String, Fundet As String
Dim I As Long, Y As Long
Dim NyWorkbook
Const Filespec = "*.xls"

FilePath = ThisWorkbook.Path
Application.ScreenUpdating = False
Set FS = Application.FileSearch
With FS
    .LookIn = FilePath
    .Filename = Filespec
    .SearchSubFolders = False
    .Execute
    For Y = 1 To .FoundFiles.Count
        Fundet = .FoundFiles(Y)
        L = Len(ThisWorkbook.Name)
        If Fundet <> FilePath & "\" & ThisWorkbook.Name Then
            NyWorkbook = .FoundFiles(Y)
            ReDim MyWorkbook(1)
            P = 1
            For Each ws In ThisWorkbook.Worksheets
                MyWorkbook(P - 1) = ws.Name
                ReDim Preserve MyWorkbook(P)
                P = P + 1
            Next
            Workbooks.Open Filename:=NyWorkbook
            ActiveSheet.Select
            For Each ws In Worksheets
                OK = False
                For I = 1 To UBound(MyWorkbook)
                    If ws.Name = MyWorkbook(I) Then
                        OK = True
                    End If
                Next
                If OK = False Then
                    Sheets(ws.Name).Range("C6").Value = "Yes"
                End If
            Next
            ActiveWorkbook.Save
            ActiveWindow.Close
        End If
    Next
End With
Application.ScreenUpdating = False
End Sub

Ups... en lille fejl

Private Sub CommandButton1_Click()
Dim FS As FileSearch
Dim FilePath As String, Fundet As String
Dim I As Long, Y As Long
Dim NyWorkbook
Const Filespec = "*.xls"

FilePath = ThisWorkbook.Path
Application.ScreenUpdating = False
Set FS = Application.FileSearch
With FS
    .LookIn = FilePath
    .Filename = Filespec
    .SearchSubFolders = False
    .Execute
    For Y = 1 To .FoundFiles.Count
        Fundet = .FoundFiles(Y)
        L = Len(ThisWorkbook.Name)
        If Fundet <> FilePath & "\" & ThisWorkbook.Name Then
            Antal = Antal + 1
            NyWorkbook = .FoundFiles(Y)
            ReDim MyWorkbook(1)
            P = 1
            For Each ws In ThisWorkbook.Worksheets
                MyWorkbook(P - 1) = ws.Name
                ReDim Preserve MyWorkbook(P)
                P = P + 1
            Next
            Workbooks.Open Filename:=NyWorkbook
            Application.StatusBar = "Retter " & Fundet
            ActiveSheet.Select
            For Each ws In Worksheets
                OK = False
                For I = 1 To UBound(MyWorkbook)
                    If ws.Name = MyWorkbook(I) Then
                        OK = True
                    End If
                Next
                If OK = False Then
                    Sheets(ws.Name).Range("C6").Value = "Yes"
                End If
            Next
            ActiveWorkbook.Save
            ActiveWindow.Close
        End If
    Next
End With
Application.StatusBar = "Rettede " & Antal & " filer"
End Sub

Fornemt ... læg venligst svar :o)

Velbekomme :-)