Private Sub Workbook_Open()
    UserForm1.Show
End Sub

Sub f()
    Dim nime As String, sh As String, pt As String, fname As String, cel As String
    Dim k As Long, n As Long
    nime = "2.xlsx"
    sh = "Лист1"
    pt = "C:\Documents and Settings\Administrator\Desktop\Склад\"
    fname = pt & nime
    k =  1 
    n =  1 
        If FileExists3(fname) = False Then
            MsgBox ("Файл " & fname & " не существует.")
        Else
            On Error Resume Next
            Do
                cel = "A" & n
                
                With Workbooks("Касса.xlsm").Sheets("Лист1")
                    .Cells(k,  1 ).Value = Getvalue(pt, nime, sh, cel)
                    .Cells(k,  2 ).Value = Getvalue(pt, nime, sh, "C" & n)
                    .Cells(k,  3 ).Value = Getvalue(pt, nime, sh, "D" & n)
                    .Cells(k,  4 ).Value = Getvalue(pt, nime, sh, "E" & n)
                    .Cells(k,  5 ).Value = Getvalue(pt, nime, sh, "F" & n)
                End With
                n = n +  1 
                k = k +  1 
            Loop Until Getvalue(pt, nime, sh, cel) =  0 
                    
            If Err Then MsgBox "Ошибка!"

        End If

End Sub
Private Function Getvalue(path, file, sheet, ref)
    Dim Arg As String
    Arg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
    Getvalue = ExecuteExcel4Macro(Arg)
End Function
Private Function FileExists3(fname) As Boolean
    Set filesys = CreateObject("scripting.filesystemobject")
    FileExists3 = filesys.fileexists(fname)
End Function

Private Sub MultiPage1_Change()
    If Not EventsOff And Me.CheckBox1.Value = True Then
        MsgBox "Page" & Me.MultiPage1.Value +  1 
    End If
End Sub

With Workbooks("Касса.xlsm").Sheets("Лист1")
                    .Cells(k,  [b]1 ).Value[/b] = Getvalue(pt, nime, sh, cel)
                                   End With

With Workbooks("Касса.xlsm").Sheets("Лист1")
     .Range(.Cells(k, "A"),.Cells(s, "A")).Value = Getvalue(pt, nime, sh, cel)
End With