Доброго дня! Есть код который собирает данные из других книг, но при запросе он открывает рабочий стол. Можно ли изменить этот код чтоб открывалась конкретная папка для вывбора файлов. Спасибо.
[vba]
Код
Dim fPath$ Dim spPath, spName Dim A() Dim i&, x With Application.FileDialog(msoFileDialogFilePicker) .Filters.Clear .Filters.Add "Microsoft Excel files", "*.xls" .AllowMultiSelect = True .InitialFileName = ThisWorkbook.Path If .Show = 0 Then Exit Sub For x = 1 To .SelectedItems.Count
With ActiveWorkbook With .ActiveSheet A = .Range("B3:D60" & .Cells(Rows.Count, 1).End(xlUp).Row).Value End With .Close False End With
With Sheets("Перечень") lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1 For i = 1 To UBound(A) If A(i, 1) <> "" Then '.Cells(lr, 1) = spName(0) 'номер '.Cells(lr, 2) = Replace(spName(2), ".xls", "") 'фамилия .Cells(lr, 2) = A(i, 1) 'Номер .Cells(lr, 4) = A(i, 3) 'Кол-во lr = lr + 1 End If Next End With
Next End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub
[/vba]
Доброго дня! Есть код который собирает данные из других книг, но при запросе он открывает рабочий стол. Можно ли изменить этот код чтоб открывалась конкретная папка для вывбора файлов. Спасибо.
[vba]
Код
Dim fPath$ Dim spPath, spName Dim A() Dim i&, x With Application.FileDialog(msoFileDialogFilePicker) .Filters.Clear .Filters.Add "Microsoft Excel files", "*.xls" .AllowMultiSelect = True .InitialFileName = ThisWorkbook.Path If .Show = 0 Then Exit Sub For x = 1 To .SelectedItems.Count
With ActiveWorkbook With .ActiveSheet A = .Range("B3:D60" & .Cells(Rows.Count, 1).End(xlUp).Row).Value End With .Close False End With
With Sheets("Перечень") lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1 For i = 1 To UBound(A) If A(i, 1) <> "" Then '.Cells(lr, 1) = spName(0) 'номер '.Cells(lr, 2) = Replace(spName(2), ".xls", "") 'фамилия .Cells(lr, 2) = A(i, 1) 'Номер .Cells(lr, 4) = A(i, 3) 'Кол-во lr = lr + 1 End If Next End With
Next End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub