Здравствуйте! Есть два файла. В файл " 3742591" вносятся данные. А как сделать так, что бы из ячейки a26 в этом файле информация автоматический переносилась в столбец А в файл "8985951" в следующую свободную строку? У меня в файле есть макрос [vba]
Код
Sub Лист_в_файл() 'Сохранить текущий лист. Application.ScreenUpdating = False Dim List$, iPath$, newName$ With Application.FileDialog(msoFileDialogFolderPicker) .ButtonName = "Выбрать" .Title = "Выберите и откройте папку для сохранения файлов." .InitialFileName = iPath If .Show = False Then Exit Sub iPath = .SelectedItems(1) & "\" End With Application.ScreenUpdating = False Application.DisplayAlerts = False List = ActiveSheet.Name newName = Sheets(List).Cells(1, 1) Sheets(List).Copy Sheets(List).UsedRange.Value = Sheets(List).UsedRange.Value Sheets(List).DrawingObjects.Delete 'Удаляем все элементы Sheets(List).Buttons.Delete Sheets(List).Columns("a:e").Delete Sheets(List).Columns("bc:br").Delete ActiveWorkbook.SaveAs iPath & newName '& ".xls" ActiveWorkbook.Close False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba] Который сохраняет в отдельную книгу. Можно ли при выполнении данного макроса, сделать то, что описано выше?
Пока писал вопрос, понял что, видимо, вопрос надо было задать в разделе по VBA...
Здравствуйте! Есть два файла. В файл " 3742591" вносятся данные. А как сделать так, что бы из ячейки a26 в этом файле информация автоматический переносилась в столбец А в файл "8985951" в следующую свободную строку? У меня в файле есть макрос [vba]
Код
Sub Лист_в_файл() 'Сохранить текущий лист. Application.ScreenUpdating = False Dim List$, iPath$, newName$ With Application.FileDialog(msoFileDialogFolderPicker) .ButtonName = "Выбрать" .Title = "Выберите и откройте папку для сохранения файлов." .InitialFileName = iPath If .Show = False Then Exit Sub iPath = .SelectedItems(1) & "\" End With Application.ScreenUpdating = False Application.DisplayAlerts = False List = ActiveSheet.Name newName = Sheets(List).Cells(1, 1) Sheets(List).Copy Sheets(List).UsedRange.Value = Sheets(List).UsedRange.Value Sheets(List).DrawingObjects.Delete 'Удаляем все элементы Sheets(List).Buttons.Delete Sheets(List).Columns("a:e").Delete Sheets(List).Columns("bc:br").Delete ActiveWorkbook.SaveAs iPath & newName '& ".xls" ActiveWorkbook.Close False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba] Который сохраняет в отдельную книгу. Можно ли при выполнении данного макроса, сделать то, что описано выше?
Пока писал вопрос, понял что, видимо, вопрос надо было задать в разделе по VBA...AVI
AVI, из ячейки А26 или все-таки номер из В2? [vba]
Код
Sub copyRow() Application.ScreenUpdating = False Dim wbPath$, sh1 As Worksheet, wb As Workbook, lr& Set sh1 = ThisWorkbook.Sheets(1) wbPath = ThisWorkbook.Path & "\8985951.xlsx" 'Путь с книгой, куда копируем строку Set wb = Workbooks.Open(wbPath) With wb.Sheets(1) lr = .Cells(Rows.Count, 1).End(xlUp).Row .Cells(lr + 1, 1) = sh1.Cells(1, "b")' Для А26 sh1.Cells(26, "a") End With Application.DisplayAlerts = False wb.Close True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba] Вставьте вызов макроса в нужное место своего макроса, например: [vba]
Код
Sub Лист_в_файл() 'Сохранить текущий лист. Application.ScreenUpdating = False copyRow
[/vba]
[p.s.]Для оформления кодов используйте кнопку #, а не спойлер.[/p.s.]
AVI, из ячейки А26 или все-таки номер из В2? [vba]
Код
Sub copyRow() Application.ScreenUpdating = False Dim wbPath$, sh1 As Worksheet, wb As Workbook, lr& Set sh1 = ThisWorkbook.Sheets(1) wbPath = ThisWorkbook.Path & "\8985951.xlsx" 'Путь с книгой, куда копируем строку Set wb = Workbooks.Open(wbPath) With wb.Sheets(1) lr = .Cells(Rows.Count, 1).End(xlUp).Row .Cells(lr + 1, 1) = sh1.Cells(1, "b")' Для А26 sh1.Cells(26, "a") End With Application.DisplayAlerts = False wb.Close True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba] Вставьте вызов макроса в нужное место своего макроса, например: [vba]
Код
Sub Лист_в_файл() 'Сохранить текущий лист. Application.ScreenUpdating = False copyRow
[/vba]
[p.s.]Для оформления кодов используйте кнопку #, а не спойлер.[/p.s.]Manyasha
Попробовал в Вашем файле прикрутить кнопку. Указал нужный путь (кириллицу можно использовать?). При выполнении вываливается ошибка и в макросе выделяется желтым строчка [vba]
Код
Set wb = Workbooks.Open(wbPath)
[/vba]
Попробовал в Вашем файле прикрутить кнопку. Указал нужный путь (кириллицу можно использовать?). При выполнении вываливается ошибка и в макросе выделяется желтым строчка [vba]
Sub copyRow() Application.ScreenUpdating = False Dim wbPath$, sh1 As Worksheet, wb As Workbook, lr& Set sh1 = ThisWorkbook.Sheets(1) wbPath = "C:\Users\FondUser\Desktop\sogl\8985951.xlsx" Set wb = Workbooks.Open(wbPath) With wb.Sheets(1) lr = .Cells(Rows.Count, 1).End(xlUp).Row .Cells(lr + 1, 1) = sh1.Cells(26, "a") End With Application.DisplayAlerts = False wb.Close True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba] Подскажите, как в указанном коде указать с какого именно листа из ячейки A26 брать информацию. Тут по умолчанию стоит первый лист.
Прошу еще помочь видоизменить макрос. [vba]
Код
Sub copyRow() Application.ScreenUpdating = False Dim wbPath$, sh1 As Worksheet, wb As Workbook, lr& Set sh1 = ThisWorkbook.Sheets(1) wbPath = "C:\Users\FondUser\Desktop\sogl\8985951.xlsx" Set wb = Workbooks.Open(wbPath) With wb.Sheets(1) lr = .Cells(Rows.Count, 1).End(xlUp).Row .Cells(lr + 1, 1) = sh1.Cells(26, "a") End With Application.DisplayAlerts = False wb.Close True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba] Подскажите, как в указанном коде указать с какого именно листа из ячейки A26 брать информацию. Тут по умолчанию стоит первый лист.AVI
Sub copyRow() 'Отключаем обновление экрана Application.ScreenUpdating = False 'Объявление используемых переменных Dim wbPath$, sh1 As Worksheet, wb As Workbook, lr& '!!!присваеваем переменной sh1 ссылку на 1-й лист ЭТОЙ книги!!! Set sh1 = ThisWorkbook.Sheets(1) 'путь к новой книге (куда копируем) wbPath = "C:\Users\FondUser\Desktop\sogl\8985951.xlsx" 'Ссылка на новую книгу (куда копируем) Set wb = Workbooks.Open(wbPath) 'Для 1-го листа книги wb выполняем: With wb.Sheets(1) 'в переменную lr записываем последнюю заполненную строчку в 1-м столбце lr = .Cells(Rows.Count, 1).End(xlUp).Row 'в ячейку с номером строки lr+1 и номером столбца 1 копируем значение А26 с листа sh1 .Cells(lr + 1, 1) = sh1.Cells(26, "a") End With 'отключаем вывод сообщений на экран Application.DisplayAlerts = False 'закрываем книгу wb с сохранением wb.Close True 'включаем вывод сообщений Application.DisplayAlerts = True 'включаем обновление экрана Application.ScreenUpdating = True End Sub
указать с какого именно листа из ячейки A26 брать информацию
смотрите строку с восклицательными знаками. Почитайте про Sheets, вместо номера листа можно указать его имя (name) или обращаться к листу по кодовому имени (codeName)
AVI, прокомментировала каждую строчку: [vba]
Код
Sub copyRow() 'Отключаем обновление экрана Application.ScreenUpdating = False 'Объявление используемых переменных Dim wbPath$, sh1 As Worksheet, wb As Workbook, lr& '!!!присваеваем переменной sh1 ссылку на 1-й лист ЭТОЙ книги!!! Set sh1 = ThisWorkbook.Sheets(1) 'путь к новой книге (куда копируем) wbPath = "C:\Users\FondUser\Desktop\sogl\8985951.xlsx" 'Ссылка на новую книгу (куда копируем) Set wb = Workbooks.Open(wbPath) 'Для 1-го листа книги wb выполняем: With wb.Sheets(1) 'в переменную lr записываем последнюю заполненную строчку в 1-м столбце lr = .Cells(Rows.Count, 1).End(xlUp).Row 'в ячейку с номером строки lr+1 и номером столбца 1 копируем значение А26 с листа sh1 .Cells(lr + 1, 1) = sh1.Cells(26, "a") End With 'отключаем вывод сообщений на экран Application.DisplayAlerts = False 'закрываем книгу wb с сохранением wb.Close True 'включаем вывод сообщений Application.DisplayAlerts = True 'включаем обновление экрана Application.ScreenUpdating = True End Sub
указать с какого именно листа из ячейки A26 брать информацию
смотрите строку с восклицательными знаками. Почитайте про Sheets, вместо номера листа можно указать его имя (name) или обращаться к листу по кодовому имени (codeName)Manyasha
смотрите строку с восклицательными знаками. Почитайте про Sheets, вместо номера листа можно указать его имя (name) или обращаться к листу по кодовому имени (codeName)
[vba]
Код
Sub copyRow() 'Отключаем обновление экрана Application.ScreenUpdating = False 'Объявление используемых переменных Dim wbPath$, sh1 As Worksheet, wb As Workbook, lr& Set sh1 = ThisWorkbook.Worksheets("Вводные") '!!!присваеваем переменной sh1 ссылку на 1-й лист ЭТОЙ книги!!! 'путь к новой книге (куда копируем) wbPath = "C:\Users\FondUser\Desktop\sogl\8985951.xlsx" 'Ссылка на новую книгу (куда копируем) Set wb = Workbooks.Open(wbPath) 'Для 1-го листа книги wb выполняем: With wb.Sheets(1) 'в переменную lr записываем последнюю заполненную строчку в 1-м столбце lr = .Cells(Rows.Count, 1).End(xlUp).Row 'в ячейку с номером строки lr+1 и номером столбца 1 копируем значение А26 с листа sh1 .Cells(lr + 1, 1) = sh1.Cells(26, "a") End With 'отключаем вывод сообщений на экран Application.DisplayAlerts = False 'закрываем книгу wb с сохранением wb.Close True 'включаем вывод сообщений Application.DisplayAlerts = True 'включаем обновление экрана Application.ScreenUpdating = True End Sub
[/vba] Прочитал, внес, выдает ошибку. Видимо не то внес. Нужный лист называется "Вводные". Помогите, пожалуйста.
смотрите строку с восклицательными знаками. Почитайте про Sheets, вместо номера листа можно указать его имя (name) или обращаться к листу по кодовому имени (codeName)
[vba]
Код
Sub copyRow() 'Отключаем обновление экрана Application.ScreenUpdating = False 'Объявление используемых переменных Dim wbPath$, sh1 As Worksheet, wb As Workbook, lr& Set sh1 = ThisWorkbook.Worksheets("Вводные") '!!!присваеваем переменной sh1 ссылку на 1-й лист ЭТОЙ книги!!! 'путь к новой книге (куда копируем) wbPath = "C:\Users\FondUser\Desktop\sogl\8985951.xlsx" 'Ссылка на новую книгу (куда копируем) Set wb = Workbooks.Open(wbPath) 'Для 1-го листа книги wb выполняем: With wb.Sheets(1) 'в переменную lr записываем последнюю заполненную строчку в 1-м столбце lr = .Cells(Rows.Count, 1).End(xlUp).Row 'в ячейку с номером строки lr+1 и номером столбца 1 копируем значение А26 с листа sh1 .Cells(lr + 1, 1) = sh1.Cells(26, "a") End With 'отключаем вывод сообщений на экран Application.DisplayAlerts = False 'закрываем книгу wb с сохранением wb.Close True 'включаем вывод сообщений Application.DisplayAlerts = True 'включаем обновление экрана Application.ScreenUpdating = True End Sub
[/vba] Прочитал, внес, выдает ошибку. Видимо не то внес. Нужный лист называется "Вводные". Помогите, пожалуйста.AVI
Сообщение отредактировал AVI - Четверг, 15.09.2016, 11:54
смотрите строку с восклицательными знаками. Почитайте про Sheets, вместо номера листа можно указать его имя (name) или обращаться к листу по кодовому имени (codeName)
смотрите строку с восклицательными знаками. Почитайте про Sheets, вместо номера листа можно указать его имя (name) или обращаться к листу по кодовому имени (codeName)
Manyasha, А что бы мне добавить еще одно место куда нужно перенести информацию из ячейки A26 с затиранием предыдущей записи мне нужно создать новую переменную?
Manyasha, А что бы мне добавить еще одно место куда нужно перенести информацию из ячейки A26 с затиранием предыдущей записи мне нужно создать новую переменную?AVI
Сообщение отредактировал AVI - Четверг, 22.09.2016, 12:47
Решил проблему несколько коряво, но работает [vba]
Код
Sub copyRow() 'Отключаем обновление экрана Application.ScreenUpdating = False 'Объявление используемых переменных Dim wbPath$, sh1 As Worksheet, wb As Workbook, lr& Set sh1 = ThisWorkbook.Worksheets("Вводные") '!!!присваеваем переменной sh1 ссылку на 1-й лист ЭТОЙ книги!!! 'путь к новой книге (куда копируем) wbPath = "C:\Users\Администратор\Desktop\на продажу\Лист Microsoft Excel.xlsx" 'Ссылка на новую книгу (куда копируем) Set wb = Workbooks.Open(wbPath) 'Для 1-го листа книги wb выполняем: With wb.Sheets(1) 'в переменную lr записываем последнюю заполненную строчку в 1-м столбце lr = .Cells(Rows.Count, 1).End(xlUp).Row 'в ячейку с номером строки lr+1 и номером столбца 1 копируем значение А26 с листа sh1 .Cells(lr + 1, 1) = sh1.Cells(26, "a") End With 'отключаем вывод сообщений на экран Application.DisplayAlerts = False 'закрываем книгу wb с сохранением wb.Close True 'включаем вывод сообщений Application.DisplayAlerts = True 'включаем обновление экрана Application.ScreenUpdating = True End Sub Sub Макрос2() Range("A26").Select Selection.Copy Range("B26").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveWorkbook.Save End Sub Sub Макрос3() Call copyRow Call Макрос2 End Sub
[/vba]
Решил проблему несколько коряво, но работает [vba]
Код
Sub copyRow() 'Отключаем обновление экрана Application.ScreenUpdating = False 'Объявление используемых переменных Dim wbPath$, sh1 As Worksheet, wb As Workbook, lr& Set sh1 = ThisWorkbook.Worksheets("Вводные") '!!!присваеваем переменной sh1 ссылку на 1-й лист ЭТОЙ книги!!! 'путь к новой книге (куда копируем) wbPath = "C:\Users\Администратор\Desktop\на продажу\Лист Microsoft Excel.xlsx" 'Ссылка на новую книгу (куда копируем) Set wb = Workbooks.Open(wbPath) 'Для 1-го листа книги wb выполняем: With wb.Sheets(1) 'в переменную lr записываем последнюю заполненную строчку в 1-м столбце lr = .Cells(Rows.Count, 1).End(xlUp).Row 'в ячейку с номером строки lr+1 и номером столбца 1 копируем значение А26 с листа sh1 .Cells(lr + 1, 1) = sh1.Cells(26, "a") End With 'отключаем вывод сообщений на экран Application.DisplayAlerts = False 'закрываем книгу wb с сохранением wb.Close True 'включаем вывод сообщений Application.DisplayAlerts = True 'включаем обновление экрана Application.ScreenUpdating = True End Sub Sub Макрос2() Range("A26").Select Selection.Copy Range("B26").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveWorkbook.Save End Sub Sub Макрос3() Call copyRow Call Макрос2 End Sub
добавить еще одно место куда нужно перенести информацию из ячейки A26
Вот этот блок отвечает за копирование: [vba]
Код
'Ссылка на новую книгу (куда копируем) Set wb = Workbooks.Open(wbPath) 'Для 1-го листа книги wb выполняем: With wb.Sheets(1) 'в переменную lr записываем последнюю заполненную строчку в 1-м столбце lr = .Cells(Rows.Count, 1).End(xlUp).Row 'в ячейку с номером строки lr+1 и номером столбца 1 копируем значение А26 с листа sh1 .Cells(lr + 1, 1) = sh1.Cells(26, "a") End With
[/vba] Если книга изменилась, нужно открывать новую (переменная wb). Если книга та же, но другой лист, смотрим wb.Sheets(1), меняем лист на нужный.
Как я поняла, в Вашем случае нужно было добавить только одну строчку: [vba]
добавить еще одно место куда нужно перенести информацию из ячейки A26
Вот этот блок отвечает за копирование: [vba]
Код
'Ссылка на новую книгу (куда копируем) Set wb = Workbooks.Open(wbPath) 'Для 1-го листа книги wb выполняем: With wb.Sheets(1) 'в переменную lr записываем последнюю заполненную строчку в 1-м столбце lr = .Cells(Rows.Count, 1).End(xlUp).Row 'в ячейку с номером строки lr+1 и номером столбца 1 копируем значение А26 с листа sh1 .Cells(lr + 1, 1) = sh1.Cells(26, "a") End With
[/vba] Если книга изменилась, нужно открывать новую (переменная wb). Если книга та же, но другой лист, смотрим wb.Sheets(1), меняем лист на нужный.
Как я поняла, в Вашем случае нужно было добавить только одну строчку: [vba]