Excel 2013 - "Aprire elenco file .xlsm ed inserire una colonna in ciascuno di loro

Ciao a tutti,

Ho un elenco di file contenuti in una cartella, tutti i file hanno la stessa struttura.

Io devo aprire ogni file ed inserire una colonna nella colonna A intestandola ed assegnando un valore alla prima cella.

La mia routine "sembra" funzionare però si ferma al primo file individuato nella cartella che contiene i file e non inserisce la colonna desiderata, dove sto sbagliando ? mi dareste qualche suggerimento ?
grazie

'****************************************************************
'* Inserisce per ogni file contenuto nella cartella il nome dell'operatore
'****************************************************************

Sub Secondo_AggiungiColonnaPerOgniFile()
    Dim fDialog As FileDialog
    Dim i As Integer
    Dim ur As Long
    Dim uR1 As Long
    Dim WK As Workbook
    Dim WK1 As Workbook
    Dim sh As Worksheet
    Dim sh1 As Worksheet
    Dim fs As Object
    Dim Fold As Object
    Dim Nomefile As Object
    Dim cartella As Variant
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    MsgBox "Scegli la cartella con i files!", vbInformation, "AVVISO"
    
    With fDialog
        .Show
        On Error GoTo esci
        cartella = .SelectedItems(1)
    End With
    
    Set WK = ThisWorkbook
    Set sh = WK.Worksheets(1)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set Fold = fs.getfolder(cartella)
    Set cartella = Fold.Files
    For Each Nomefile In cartella
    
       Set WK1 = Workbooks.Open(Nomefile)
       Set sh1 = WK1.Worksheets(1)
     
       'questa è la parte che dovrebbe eseguire per ogni file 
       Columns("A:A").Select
       Selection.Insert Shift:=xlToRight
       Range("A1").Select
       ActiveCell.Value = "Nome"
       Range("A2").Select
       ActiveCell.Value = "aaaa"
       
       ActiveWorkbook.Save
       ActiveWorkbook.Close

       Application.DisplayAlerts = True

       WS.AutoFilterMode = False
       WS.Activate

       'salva il file una aggiornato e passa al successivo
       ActiveWorkbook.Save
       ActiveWorkbook.Close
    Next
    WK.Save

  
    'qui non mi restituisce nulla mentre dovrebbe avvisarmi che ha finito
    MsgBox "Fatto!", vbInformation, "NOTIFICA"
    Set fs = Nothing
    Set cartella = Nothing
    Set Fold = Nothing
esci:
    Set fDialog = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Grazie a tutti.

Ciao,
queste due righe:

       WS.AutoFilterMode = False
       WS.Activate

Fai riferimento all'oggetto WS, ma nel tuo codice non se ne trova traccia.
Tra l'altro hai una gestione che consente solo l'uscita dalla routine, quindi l'errore non viene evidenziato.
Se usassi l'Option Explicit quelle righe, se la variabile non fosse dichiarata, darebbero errore.

TheTruster

Originariamente inviato da TheTruster

Ciao,
queste due righe:

       WS.AutoFilterMode = False
       WS.Activate

Fai riferimento all'oggetto WS, ma nel tuo codice non se ne trova traccia.
Tra l'altro hai una gestione che consente solo l'uscita dalla routine, quindi l'errore non viene evidenziato.
Se usassi l'Option Explicit quelle righe, se la variabile non fosse dichiarata, darebbero errore.

TheTruster

Ti ringrazio TheTruster, ci lavoro sopra.

Oltre a quanto segnalato da TheTruster, noto che i metodi [ActiveWorkbook.Save] e [ActiveWorkbook.Close], sono richiamati due volte all'interno del ciclo.
Non è che il secondo Save genera errore e non lo vedi per l'[On Error GoTo esci]?

Originariamente inviato da Sgrubak

Oltre a quanto segnalato da TheTruster, noto che i metodi [ActiveWorkbook.Save] e [ActiveWorkbook.Close], sono richiamati due volte all'interno del ciclo.
Non è che il secondo Save genera errore e non lo vedi per l'[On Error GoTo esci]?

grazie, ci lavoro sopra

Buon giorno a tutti,

non mi sembra una soluzione molto elegante però sono riuscito a risolvere il mio problema, utilizzo un foglio come format e lo replico rinominando ogni nuovo singolo foglio prendendo il nome da un elenco così come la prima colonna (l'idea è che una volta ricevuti gli n. fogli con un unico passaggio li posso aggregare), nella fase di copia ogni foglio viene protetto da password.

 Sub Copia_e_nomina_fogli()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim Nr As Integer
    Dim NomeDip As String
    Application.ScreenUpdating = False
    Set sh1 = Worksheets("Orario")
    Set sh2 = Worksheets("Complessivo")
    
   'cicla l'elenco dei nomi
    
    For i = 2 To sh2.Cells(Rows.Count, 1).End(xlUp).Row
        
        'se la prima cella dell'elenco non è vuota
        If sh2.Cells(i, 1) <> "" Then
            NomeFoglio = RTrim(sh2.Cells(i, 1))
            
            NomeFoglio = Replace(Replace(NomeFoglio, " - ", "_"), " ", "_")
            
            Sheets("Orario").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = NomeFoglio
            
            'assegna il nome alla prima colonna del foglio
            ActiveSheet.Cells(2, 1).Value = Sheets("Complessivo").Cells(i, 1)
            
            'conta il numero di record della colonna precompilata che verrà distribuita
            LastRow = sh1.UsedRange.Rows.Count
          
            
           'riempie con il nome del dipendente la colonna, ricorda di aggiornare il count delle righe
            For Nr = 2 To LastRow
               ActiveSheet.Cells(Nr, 1).Value = NomeFoglio
            Next
                        
            ActiveSheet.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
            :=True
     
            Sheets(NomeFoglio).Move After:=Sheets(Worksheets.Count)
            
        End If
    Next i
    Sheets("Menu").Select
    Application.ScreenUpdating = True
End Sub

Accetto ovviamente consigli su errori occulti o migliorie

Grazie a tutti.

buona giornata.

Ma prima di cambiare completamente approccio, hai lavorato su quel che ti abbiamo fatto notare io e TheTruster?

Originariamente inviato da Sgrubak

Ma prima di cambiare completamente approccio, hai lavorato su quel che ti abbiamo fatto notare io e TheTruster?

ho provato a fare il debug riga per riga però i miei tentativi non mi hanno dato la soddisfazione richiesta, la soluzione che ho trovato è frutto dell'empasse in cui ero finito

Originariamente inviato da stige

la soluzione che ho trovato è frutto dell'empasse in cui ero finito

Per carità! È chiaro che se uno deve risolvere il problema, la prima soluzione che funziona va bene...

Ma ai fini della discussione, sei partito dicendo che avevi un problema a ciclare delle cartelle ed inserire delle colonne, e risolvi tutto ciclando dei fogli? Cioè se anche io il problema di "Aprire elenco file .xlsm ed inserire una colonna in ciascuno di loro" e con google finisco qui, che beneficio ho della tua soluzione visto che fa tutt'altra cosa?