Доброго времени суток! Прошу Вашей помощи в написании макроса: необходимо чтобы при нажатии на кнопку происходило открытие окна для выбора файла. Потом когда файл выбран - перенести данные с выбраного файла (с диапазона С5-AZ90000) в эту книгу начиная с А5 Заранее благодарю за помощь.
Доброго времени суток! Прошу Вашей помощи в написании макроса: необходимо чтобы при нажатии на кнопку происходило открытие окна для выбора файла. Потом когда файл выбран - перенести данные с выбраного файла (с диапазона С5-AZ90000) в эту книгу начиная с А5 Заранее благодарю за помощь.rtv206
Вот, пожалуйста) Только под себя подстройте, тут тоже легко .
[vba]
Код
Private Sub NZ_Add() Dim FilesToOpen, importWb1, importWb Dim vbReportArray As Variant Dim vbAllInformation(6, 12) As Variant Dim x, z, c, k, l, p As Integer x = 1 z = 3 c = 26 k = 1 l = 0 p = 6 FilesToOpen = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", _ MultiSelect:=True, Title:="Files to Merge") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "Не выбрано ни одного файла!" Exit Sub End If Set importWb1 = CreateObject("Excel.Sheet") If TypeName(FilesToOpen) <> "Boolean" Then While x <= UBound(FilesToOpen) Application.ScreenUpdating = False Erase vbAllInformation Set importWb = importWb1.Application.Workbooks.Open(Filename:=FilesToOpen(x))
While k < 20 If Workbooks(importWb.name).Worksheets(1).Cells(c, 1).Value = "" Then k = k + 1 If Workbooks(importWb.name).Worksheets(1).Cells(c, 1).Value <> "" Then k = 1 c = c + 1 Wend
While ThisWorkbook.Worksheets("Лист1").Cells(p, 7).Value <> "" p = p + 1 Wend
c = c - k vbReportArray = Workbooks(importWb.name).Worksheets(1).Range("A28:H" & CStr(c)).Value My_un_protect For i = 28 To c
'ArrayInWorkbook (vbAllInformation) z = 3 x = x + 1 importWb.Close savechanges:=False Set importWb = Nothing Wend Set importWb1 = Nothing End If forma Application.ScreenUpdating = True Nomer_NZ.Show End Sub
[/vba]
Вот, пожалуйста) Только под себя подстройте, тут тоже легко .
[vba]
Код
Private Sub NZ_Add() Dim FilesToOpen, importWb1, importWb Dim vbReportArray As Variant Dim vbAllInformation(6, 12) As Variant Dim x, z, c, k, l, p As Integer x = 1 z = 3 c = 26 k = 1 l = 0 p = 6 FilesToOpen = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", _ MultiSelect:=True, Title:="Files to Merge") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "Не выбрано ни одного файла!" Exit Sub End If Set importWb1 = CreateObject("Excel.Sheet") If TypeName(FilesToOpen) <> "Boolean" Then While x <= UBound(FilesToOpen) Application.ScreenUpdating = False Erase vbAllInformation Set importWb = importWb1.Application.Workbooks.Open(Filename:=FilesToOpen(x))
While k < 20 If Workbooks(importWb.name).Worksheets(1).Cells(c, 1).Value = "" Then k = k + 1 If Workbooks(importWb.name).Worksheets(1).Cells(c, 1).Value <> "" Then k = 1 c = c + 1 Wend
While ThisWorkbook.Worksheets("Лист1").Cells(p, 7).Value <> "" p = p + 1 Wend
c = c - k vbReportArray = Workbooks(importWb.name).Worksheets(1).Range("A28:H" & CStr(c)).Value My_un_protect For i = 28 To c
'ArrayInWorkbook (vbAllInformation) z = 3 x = x + 1 importWb.Close savechanges:=False Set importWb = Nothing Wend Set importWb1 = Nothing End If forma Application.ScreenUpdating = True Nomer_NZ.Show End Sub
Sub fdsg() Dim ImaKnigi$ ImaKnigi$ = Get_FileName Workbooks.Open (ImaKnigi$) 'делаете с выбранной книгой нужные действия и не забудьте закрыть End Sub
[/vba] В стандартный модуль [vba]
Код
Public Function Get_FileName(Optional ByVal Title As String = "Выберите файл для обработки", _ Optional ByVal FilterDescription As String = "Файлы Excel", _ Optional ByVal FilterExtention As String = "*.xls*") As String On Error Resume Next With Application.FileDialog(msoFileDialogOpen) ' .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath .Filters.Clear: .Filters.Add FilterDescription, FilterExtention If .Show <> -1 Then Exit Function Get_FileName = .SelectedItems(1) End With End Function
[/vba]
Цитата
в диалоговом окне выбирать конкретный файл
[vba]
Код
Sub fdsg() Dim ImaKnigi$ ImaKnigi$ = Get_FileName Workbooks.Open (ImaKnigi$) 'делаете с выбранной книгой нужные действия и не забудьте закрыть End Sub
[/vba] В стандартный модуль [vba]
Код
Public Function Get_FileName(Optional ByVal Title As String = "Выберите файл для обработки", _ Optional ByVal FilterDescription As String = "Файлы Excel", _ Optional ByVal FilterExtention As String = "*.xls*") As String On Error Resume Next With Application.FileDialog(msoFileDialogOpen) ' .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath .Filters.Clear: .Filters.Add FilterDescription, FilterExtention If .Show <> -1 Then Exit Function Get_FileName = .SelectedItems(1) End With End Function