код-однострочник, такое лучше на python ))

код так вставился

он такой



Sub КопироватьСНИЛС()
   On Error GoTo ErrorHandler
   
   Dim sourceFolderPath As String
   Dim destinationFilePath As String
   Dim sourceFileName As String
   Dim destinationWorkbook As Workbook
   Dim sourceWorkbook As Workbook
   Dim destinationWorksheet As Worksheet
   Dim sourceWorksheet As Worksheet
   Dim lastRow As Long
   Dim i As Long
   
   ' путь к папке "In" и путь к файлу "upload.xlsm"
   sourceFolderPath = "C:\Upload\In\"
   destinationFilePath = "C:\Upload\upload.xlsm"
   
   ' Проверка существования файлов
   If Dir(destinationFilePath) = "" Then
       MsgBox "Файл 'upload.xlsm' не найден.", vbExclamation
       Exit Sub
   End If
   
   ' Открываем файл "upload.xlsm"
   Set destinationWorkbook = Workbooks.Open(destinationFilePath)
   Set destinationWorksheet = destinationWorkbook.Sheets(1)
   
   ' Проходим по всем файлам в папке "In"
   sourceFileName = Dir(sourceFolderPath & "*.xlsx")
   Do While sourceFileName <> ""
       ' Открываем текущий файл
       On Error Resume Next
       Set sourceWorkbook = Workbooks.Open(sourceFolderPath & sourceFileName)
       On Error GoTo ErrorHandler
       
       If Not sourceWorkbook Is Nothing Then
           Set sourceWorksheet = sourceWorkbook.Sheets(1)
           
           ' Находим последнюю заполненную строку в столбце E
           lastRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, "E").End(xlUp).Row
           
           ' Копируем СНИЛС из столбца E в столбец B файла "upload.xlsm"
           For i = 20 To lastRow
               destinationWorksheet.Cells(i - 18, 2).Value = sourceWorksheet.Cells(i, 5).Value
           Next i
           
           ' Закрываем текущий файл
           sourceWorkbook.Close SaveChanges:=False
       End If
       
       ' Переходим к следующему файлу в папке "In"
       sourceFileName = Dir
   Loop
   
   ' Закрываем файл "upload.xlsm" с сохранением изменений
   destinationWorkbook.Close SaveChanges:=True
   
   ' Очищаем объекты
   Set destinationWorksheet = Nothing
   Set destinationWorkbook = Nothing
   Set sourceWorksheet = Nothing
   Set sourceWorkbook = Nothing
   
   Exit Sub
   
ErrorHandler:
   MsgBox "Произошла ошибка: " & Err.Description, vbExclamation
   ' Обработка ошибки (закрытие файлов и т.д.) может быть добавлена здесь
   
   ' Очищаем объекты
   Set destinationWorksheet = Nothing
   Set destinationWorkbook = Nothing
   Set sourceWorksheet = Nothing
   Set sourceWorkbook = Nothing
End Sub

Скрытых листов нет?
Может оказаться, что видимый первый лист первым не является.