Добрый день . Имеется 2 файла "Дислокация"-запуск макроса для получения данных с закрытой книги. файл " ф7_Н8В3_5хх" -данные для обработки. На данный момент макрос обрабатывает данные,но в процессе работы нужно переименовывать название файла с которого берутся данные(название меняются каждый день) ,а если приходится Работать на дому ,то нужно указывать другой путь. Я решил усовершенствовать обработку. +выбираем файл через диалоговое окно и прописываем путь к файлу в ячейке А1.
А как теперь скопировать данные с файла(" ф7_Н8В3_5хх") и перенести в другой файл ("Дислокация")? Имена файлов для обработки МЕНЯЮТСЯ каждый день. В архиве два файла.
Добрый день . Имеется 2 файла "Дислокация"-запуск макроса для получения данных с закрытой книги. файл " ф7_Н8В3_5хх" -данные для обработки. На данный момент макрос обрабатывает данные,но в процессе работы нужно переименовывать название файла с которого берутся данные(название меняются каждый день) ,а если приходится Работать на дому ,то нужно указывать другой путь. Я решил усовершенствовать обработку. +выбираем файл через диалоговое окно и прописываем путь к файлу в ячейке А1.
А как теперь скопировать данные с файла(" ф7_Н8В3_5хх") и перенести в другой файл ("Дислокация")? Имена файлов для обработки МЕНЯЮТСЯ каждый день. В архиве два файла. parovoznik
RAN, если бы знал,то не обращался бы. Файл открывается , а как потом скопировать данные с учетом выбранного пути,это не знаю. Поэтому обратился за помощью.
RAN, если бы знал,то не обращался бы. Файл открывается , а как потом скопировать данные с учетом выбранного пути,это не знаю. Поэтому обратился за помощью. parovoznik
Sub Get_Value_From_Close_Book2() On Error Resume Next fn_ = Range("A1") fn0_ = Mid(fn_, InStrRev(fn_, "\") + 1) With Workbooks(fn0_) .Worksheets("TDSheet").Range("A4").Resize(5, 14).Copy Range("A5").Resize(5, 14) .Close End With End Sub
Sub ОткрытьФайл() ИмяФайла = Application.GetOpenFilename(, , "Выбор файла") ' запрашиваем имя файла Range("A1") = ИмяФайла If ИмяФайла = False Then Exit Sub ' выход, если пользователь отказался от выбора файла Workbooks.Open ИмяФайла End Sub '============= 'Или всё сразу Sub tt() fn_ = Application.GetOpenFilename(, , "Выбор файла") Range("A1") = fn_ If fn_ = False Then Exit Sub ' выход, если пользователь отказался от выбора файла Workbooks.Open fn_ fn0_ = Mid(fn_, InStrRev(fn_, "\") + 1) ThisWorkbook.Activate With Workbooks(fn0_) .Worksheets("TDSheet").Range("A4").Resize(5, 14).Copy Range("A5").Resize(5, 14) .Close 0 End With End Sub
[/vba]
* Чуть подправил и файл довложил
Так нужно? [vba]
Код
Sub Get_Value_From_Close_Book2() On Error Resume Next fn_ = Range("A1") fn0_ = Mid(fn_, InStrRev(fn_, "\") + 1) With Workbooks(fn0_) .Worksheets("TDSheet").Range("A4").Resize(5, 14).Copy Range("A5").Resize(5, 14) .Close End With End Sub
Sub ОткрытьФайл() ИмяФайла = Application.GetOpenFilename(, , "Выбор файла") ' запрашиваем имя файла Range("A1") = ИмяФайла If ИмяФайла = False Then Exit Sub ' выход, если пользователь отказался от выбора файла Workbooks.Open ИмяФайла End Sub '============= 'Или всё сразу Sub tt() fn_ = Application.GetOpenFilename(, , "Выбор файла") Range("A1") = fn_ If fn_ = False Then Exit Sub ' выход, если пользователь отказался от выбора файла Workbooks.Open fn_ fn0_ = Mid(fn_, InStrRev(fn_, "\") + 1) ThisWorkbook.Activate With Workbooks(fn0_) .Worksheets("TDSheet").Range("A4").Resize(5, 14).Copy Range("A5").Resize(5, 14) .Close 0 End With End Sub
[/vba]Там 2 таких Ресайза. Вместо 5 нужно 11. Но у Вас в приложенном файле было именно так, откуда я мог знать как Вам нужно? По идее там нужно что-то типа (на работу тороплюсь, без проверки сходу пишу, могу накосячить) [vba]
А вообще-то нужно бы показать что Вы добавили куда
* Доехал до работы. Держите
[vba]
Код
Sub Get_Value_From_Close_Book2() On Error Resume Next fn_ = Range("A1") fn0_ = Mid(fn_, InStrRev(fn_, "\") + 1) With Workbooks(fn0_) With .Worksheets("TDSheet") n_ = .Cells(.Rows.Count, 1).End(3).Row - 3 .Range("A4").Resize(n_, 14).Copy Range("A5").Resize(n_, 14) End With .Close 0 End With End Sub
Sub ОткрытьФайл() ИмяФайла = Application.GetOpenFilename(, , "Выбор файла") ' запрашиваем имя файла Range("A1") = ИмяФайла If ИмяФайла = False Then Exit Sub ' выход, если пользователь отказался от выбора файла Workbooks.Open ИмяФайла ThisWorkbook.Activate End Sub '============= 'Или всё сразу Sub tt() fn_ = Application.GetOpenFilename(, , "Выбор файла") Range("A1") = fn_ If fn_ = False Then Exit Sub Workbooks.Open fn_ fn0_ = Mid(fn_, InStrRev(fn_, "\") + 1) ThisWorkbook.Activate With Workbooks(fn0_) With .Worksheets("TDSheet") n_ = .Cells(.Rows.Count, 1).End(3).Row - 3 .Range("A4").Resize(n_, 14).Copy Range("A5").Resize(n_, 14) End With .Close 0 End With End Sub
[/vba]
Ищите вот здесь [vba]
Код
Resize(5, 14)
[/vba]Там 2 таких Ресайза. Вместо 5 нужно 11. Но у Вас в приложенном файле было именно так, откуда я мог знать как Вам нужно? По идее там нужно что-то типа (на работу тороплюсь, без проверки сходу пишу, могу накосячить) [vba]
А вообще-то нужно бы показать что Вы добавили куда
* Доехал до работы. Держите
[vba]
Код
Sub Get_Value_From_Close_Book2() On Error Resume Next fn_ = Range("A1") fn0_ = Mid(fn_, InStrRev(fn_, "\") + 1) With Workbooks(fn0_) With .Worksheets("TDSheet") n_ = .Cells(.Rows.Count, 1).End(3).Row - 3 .Range("A4").Resize(n_, 14).Copy Range("A5").Resize(n_, 14) End With .Close 0 End With End Sub
Sub ОткрытьФайл() ИмяФайла = Application.GetOpenFilename(, , "Выбор файла") ' запрашиваем имя файла Range("A1") = ИмяФайла If ИмяФайла = False Then Exit Sub ' выход, если пользователь отказался от выбора файла Workbooks.Open ИмяФайла ThisWorkbook.Activate End Sub '============= 'Или всё сразу Sub tt() fn_ = Application.GetOpenFilename(, , "Выбор файла") Range("A1") = fn_ If fn_ = False Then Exit Sub Workbooks.Open fn_ fn0_ = Mid(fn_, InStrRev(fn_, "\") + 1) ThisWorkbook.Activate With Workbooks(fn0_) With .Worksheets("TDSheet") n_ = .Cells(.Rows.Count, 1).End(3).Row - 3 .Range("A4").Resize(n_, 14).Copy Range("A5").Resize(n_, 14) End With .Close 0 End With End Sub