popraw mi ten kod, by nie było odwołań do pliku  źródłowego, ale działały listy rozwijane
Listy rozwiajne są z arkusza tabele

Sub PodmienArkuszeZWyjatkiemDane()
    Dim wzorcowyWB As Workbook
    Dim backupWB As Workbook
    Dim sciezkaWzorcowy As String
    Dim folderBackup As String
    Dim plik As String
    Dim ark As Worksheet
    Dim arkWzorcowy As Worksheet
    Dim arkBackup As Worksheet
    Dim nazwaArkusza As String
    Dim cell As Range
    Dim valType As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Ścieżka do pliku wzorcowego (ten plik)
    sciezkaWzorcowy = "C:\Users\kamils\Desktop\CIACH\Cięcie kosztów Ver.0.7.xlsm"
    folderBackup = "C:\Users\kamils\Desktop\CIACH\Backup\"
    
    ' Otwórz plik wzorcowy
    Set wzorcowyWB = Workbooks.Open(sciezkaWzorcowy)
    
    ' Przechodzimy po plikach w folderze Backup
    plik = Dir(folderBackup & "*.xlsm")
    Do While plik <> ""
        ' Otwórz plik backupowy
        Set backupWB = Workbooks.Open(folderBackup & plik)
        
        ' Dla każdego arkusza w pliku wzorcowym
        For Each arkWzorcowy In wzorcowyWB.Worksheets
            nazwaArkusza = arkWzorcowy.Name
            
            ' Pomijamy arkusz "Dane"
            If nazwaArkusza <> "Dane" Then
                ' Sprawdź czy arkusz istnieje w backupie
                On Error Resume Next
                Set arkBackup = backupWB.Worksheets(nazwaArkusza)
                On Error GoTo 0
                
                If Not arkBackup Is Nothing Then
                    ' Odblokuj arkusze (brak hasła)
                    arkWzorcowy.Unprotect
                    arkBackup.Unprotect
                    
                    ' Wyczyść arkusz backupowy
                    arkBackup.Cells.Clear
                    
                    ' Skopiuj zawartość i formaty z arkusza wzorcowego do backupowego
                    arkWzorcowy.Cells.Copy
                    arkBackup.Range("A1").PasteSpecial Paste:=xlPasteAll
                    arkBackup.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
                    
                    ' Skopiuj listy rozwijane (walidacje)
                    For Each cell In arkWzorcowy.UsedRange
                        On Error Resume Next
                        valType = cell.Validation.Type
                        If Err.Number = 0 Then
                            If valType <> xlValidateInputOnly Then
                                arkBackup.Range(cell.Address).Validation.Delete
                                cell.Validation.Modify _
                                    Type:=cell.Validation.Type, _
                                    AlertStyle:=cell.Validation.AlertStyle, _
                                    Operator:=cell.Validation.Operator, _
                                    Formula1:=cell.Validation.Formula1, _
                                    Formula2:=cell.Validation.Formula2
                            End If
                        End If
                        Err.Clear
                        On Error GoTo 0
                    Next cell
                    
                    ' Zabezpiecz arkusze ponownie
                    arkWzorcowy.Protect
                    arkBackup.Protect
                Else
                    MsgBox "Arkusz " & nazwaArkusza & " nie istnieje w pliku " & plik, vbExclamation
                End If
                
                Set arkBackup = Nothing
            End If
        Next arkWzorcowy
        
        ' Zapisz i zamknij plik backupowy
        backupWB.Close SaveChanges:=True
        
        plik = Dir()
    Loop
    
    wzorcowyWB.Close SaveChanges:=False
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Podmiana arkuszy zakończona."
End Sub