Private Sub CommandButton2_Click()
    Dim i As Long
    
    With ListBox1

    For i = Me.ListBox1.ListCount - 1 To 0 Step -1

    
    
        If Me.ListBox1.Selected(i) Then
        
                If i = Me.ListBox1.ListCount - 1 Then
                Sheets("Info_list").Range("A" & i + 2).Resize(1, 7).Copy Sheets("Лист1").Range("A" & Rows.Count).End(xlUp).Offset(1)
                Sheets("Info_list").Range("A" & i + 2).Resize(1, 7).Value = ""
                j = j + 1
                Else
        
        
           j = j + 1
            Sheets("Info_list").Range("A" & i + 2).Resize(1, 7).Copy Sheets("Лист1").Range("A" & Rows.Count).End(xlUp).Offset(1)
            Sheets("Info_list").Range("A" & i + 2).Resize(1, 7).Delete
                End If
        End If
   Next i
    
    LoadListBox
    
      MsgBox "'OK'", vbInformation
End With
End Sub

#If Win64 Then
Private Declare PtrSafe Function GetComputerName Lib "kernel32" _
    Alias "GetComputerNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long
#Else
Private Declare Function GetComputerName Lib "kernel32" _
    Alias "GetComputerNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long
 
#End If

Private Declare Function GetComputerName Lib "kernel32" _
    Alias "GetComputerNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long

'проходим по всем выбранным файлам
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
      Sheets(1).Name = Sheets().Parent.Name
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        
        importWB.Close savechanges:=False
        x = x + 1
        
    Wend

    Workbooks("торг 2 позиции.xls").Sheets(1).Range("AS5:AZ5") = _
    Workbooks("позиции.xls").Sheets(1).Range("b4")

Sub Макрос1()
'
' Макрос1 Макрос
'

'
    Sheets("Лист1").Select
    Sheets("Лист1").Copy
    ChDir "C:\Users\Александр\Desktop"
    ActiveWorkbook.SaveAs Filename:="C:\Users\Александр\Desktop\Книга2.xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End Sub