Sub Copy_value()
   
    my_row = ActiveCell.Row
    my_col = (Cells(my_row, 100).End(xlToLeft).Column) + 1
    current_value = Cells(my_row, 4).Value
    If my_col < 9 Then
        my_col = 9
    End If
    Cells(my_row, my_col).Value = current_value
    
End Sub

Sub Slect_range()

    lastColumn = Sheets(1).Cells(1, 100).End(xlToLeft).Column
    lastRow = Sheets(1).Cells(1000, 1).End(xlUp).Row
    Call Add_sheets(lastColumn, lastRow)

End Sub

Sub Add_sheets(col, rows)
    
        For mRow = 1 To rows
            cell_value = Sheets("Лист1").Cells(mRow, col).Value
            sheet_name = Str(mRow) & "_" & cell_value
            On Error Resume Next
                cheker = Sheets(sheet_name).Name
                If cheker = sheet_name Then
                    Sheets(sheet_name).Cells(1, 1).Value = cell_value
                    GoTo next_row
                Else
                    Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheet_name
                    Sheets(sheet_name).Cells(1, 1).Value = cell_value
                End If
next_row:
        Next mRow
    
End Sub
 

Sub Slect_range()

    lastColumn = Sheets(1).Cells(1, 100).End(xlToLeft).Column
    lastRow = Sheets(1).Cells(1000, 1).End(xlUp).Row
    Call Add_sheets(lastColumn, lastRow)

End Sub

Sub Add_sheets(col, rows)
    
        For mRow = 1 To rows
            sheet_name = Sheets("Лист1").Cells(mRow, col).Value
            sheet_name = Str(mRow) & "_" & sheet_name
            On Error Resume Next
                cheker = Sheets(sheet_name).Name
                If cheker = sheet_name Then
                    GoTo next_row
                Else
                    Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheet_name
                    Sheets(sheet_name).Cells(1, 1).Value = sheet_name
                End If
next_row:
        Next mRow
    
End Sub
 

Sub mmmmm()
Application.ScreenUpdating = False
 


Dim Put_File, PAPKA, STROKA, NOMER As Variant
Dim II As Integer
 
 
Range("F2:G65000").Select
Selection.Delete Shift:=xlUp

For i = 2 To 100
 
PAPKA = Trim(Cells(i, 1).Value)
 
Put_File = PAPKA + "\"
 
Dim FS, KATALOG, FILE, MASSIV As Object
Set FS = CreateObject("Scripting.FileSystemObject")
Set KATALOG = FS.GetFolder(Put_File)
Set MASSIV = KATALOG.Files
STROKA = i
NOMER = 1
    For Each FILE In MASSIV '
        Cells(STROKA, 7).Value = Cells(STROKA, 7).Value & vbNewLine & FILE
        
    Next
     
 
Next i
MsgBox "READY"
Application.ScreenUpdating = True
End Sub

Sub mmmmm()
Application.ScreenUpdating = False


Dim Put_File, PAPKA, STROKA, NOMER As Variant
Dim II As Integer


Range("F2:G65000").Select
Selection.Delete Shift:=xlUp
For i = 2 To 100

PAPKA = Trim(Cells(i, 1).Value)

Put_File = PAPKA + "\"

Dim FS, KATALOG, FILE, MASSIV As Object
Set FS = CreateObject("Scripting.FileSystemObject")
Set KATALOG = FS.GetFolder(Put_File)
Set MASSIV = KATALOG.Files
STROKA = 2
NOMER = 1
    For Each FILE In MASSIV '
        Cells(STROKA, 7).Value = Cells(STROKA, 7).Value & vbNewLine & FILE
       
    Next
    

Next i
MsgBox "READY"
Application.ScreenUpdating = True
End Sub

Sub juxtaposition()

a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)

b = Array("A", "B", "C", "D", "E", "", "", "", "", "")


For i = 2 To 1000
Set myCell = Cells(i, 5)
Set My2Cell = myCell.Offset(0, 1)

If myCell.Value = a(0) Then
My2Cell.Value = b(0)
End If

If myCell.Value = a(1) Then
My2Cell.Value = b(1)
End If

If myCell.Value = a(2) Then
My2Cell.Value = b(2)
End If

If myCell.Value = a(3) Then
My2Cell.Value = b(3)
End If

If myCell.Value = a(4) Then
My2Cell.Value = b(4)
End If

If myCell.Value = a(5) Then
My2Cell.Value = b(5)
End If

Next i

End Sub