Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Автоматич. перенос стоки в другую книгу в свободную строку. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоматич. перенос стоки в другую книгу в свободную строку. (Макросы/Sub)
Автоматич. перенос стоки в другую книгу в свободную строку.
AVI Дата: Среда, 14.09.2016, 10:41 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте!
Есть два файла. В файл " 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.xlsx(8Kb) · 8985951.xlsx(8Kb)


Сообщение отредактировал Manyasha - Среда, 14.09.2016, 11:41
 
Ответить
СообщениеЗдравствуйте!
Есть два файла. В файл " 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
Дата добавления - 14.09.2016 в 10:41
Manyasha Дата: Среда, 14.09.2016, 11:55 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 1582
Репутация: 659 ±
Замечаний: 0% ±

Excel 2007, 2010
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.]
К сообщению приложен файл: 3742591-1.xlsm(17Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение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
Дата добавления - 14.09.2016 в 11:55
AVI Дата: Среда, 14.09.2016, 12:10 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
из ячейки А26 или все-таки номер из В2?

Из ячейки A26


Сообщение отредактировал AVI - Среда, 14.09.2016, 18:24
 
Ответить
Сообщение
из ячейки А26 или все-таки номер из В2?

Из ячейки A26

Автор - AVI
Дата добавления - 14.09.2016 в 12:10
AVI Дата: Среда, 14.09.2016, 18:26 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Попробовал в Вашем файле прикрутить кнопку. Указал нужный путь (кириллицу можно использовать?). При выполнении вываливается ошибка и в макросе выделяется желтым строчка
[vba]
Код
Set wb = Workbooks.Open(wbPath)
[/vba]
К сообщению приложен файл: 1285803.jpg(21Kb) · 9248791.jpg(21Kb)


Сообщение отредактировал AVI - Среда, 14.09.2016, 18:37
 
Ответить
СообщениеПопробовал в Вашем файле прикрутить кнопку. Указал нужный путь (кириллицу можно использовать?). При выполнении вываливается ошибка и в макросе выделяется желтым строчка
[vba]
Код
Set wb = Workbooks.Open(wbPath)
[/vba]

Автор - AVI
Дата добавления - 14.09.2016 в 18:26
RAN Дата: Среда, 14.09.2016, 18:40 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4277
Репутация: 829 ±
Замечаний: 0% ±

2010
Найдите отличия этой строки, и строки с картинки
[vba]
Код
wbPath = ThisWorkbook.Path & "\8985951.xlsx" 'Путь с книгой, куда копируем строк
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеНайдите отличия этой строки, и строки с картинки
[vba]
Код
wbPath = ThisWorkbook.Path & "\8985951.xlsx" 'Путь с книгой, куда копируем строк
[/vba]

Автор - RAN
Дата добавления - 14.09.2016 в 18:40
Pelena Дата: Среда, 14.09.2016, 18:41 | Сообщение № 6
Группа: Модераторы
Ранг: Экселист
Сообщений: 9839
Репутация: 2252 ±
Замечаний: 0% ±

Excel 2010 & Mac Excel 2011
Если Вы указываете полный путь, то уберите часть
[vba]
Код
ThisWorkbook.Path &
[/vba]
либо в кавычках оставьте только \имя_файла


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЕсли Вы указываете полный путь, то уберите часть
[vba]
Код
ThisWorkbook.Path &
[/vba]
либо в кавычках оставьте только \имя_файла

Автор - Pelena
Дата добавления - 14.09.2016 в 18:41
AVI Дата: Четверг, 15.09.2016, 04:14 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Найдите отличия этой строки, и строки с картинки

Я почти не разбираюсь с макросах, поэтому для меня там все непонятно
Если Вы указываете полный путь, то уберите часть

Спасибо, разобрался!
 
Ответить
Сообщение
Найдите отличия этой строки, и строки с картинки

Я почти не разбираюсь с макросах, поэтому для меня там все непонятно
Если Вы указываете полный путь, то уберите часть

Спасибо, разобрался!

Автор - AVI
Дата добавления - 15.09.2016 в 04:14
AVI Дата: Четверг, 15.09.2016, 05:10 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Прошу еще помочь видоизменить макрос.
[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 брать информацию. Тут по умолчанию стоит первый лист.
К сообщению приложен файл: import.xlsm(18Kb) · spiski.xlsx(8Kb)


Сообщение отредактировал AVI - Четверг, 15.09.2016, 10:02
 
Ответить
СообщениеПрошу еще помочь видоизменить макрос.
[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
Дата добавления - 15.09.2016 в 05:10
Manyasha Дата: Четверг, 15.09.2016, 10:40 | Сообщение № 9
Группа: Модераторы
Ранг: Старожил
Сообщений: 1582
Репутация: 659 ±
Замечаний: 0% ±

Excel 2007, 2010
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
[/vba]
указать с какого именно листа из ячейки A26 брать информацию

смотрите строку с восклицательными знаками. Почитайте про Sheets, вместо номера листа можно указать его имя (name) или обращаться к листу по кодовому имени (codeName)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение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
[/vba]
указать с какого именно листа из ячейки A26 брать информацию

смотрите строку с восклицательными знаками. Почитайте про Sheets, вместо номера листа можно указать его имя (name) или обращаться к листу по кодовому имени (codeName)

Автор - Manyasha
Дата добавления - 15.09.2016 в 10:40
AVI Дата: Четверг, 15.09.2016, 11:49 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
смотрите строку с восклицательными знаками. Почитайте про 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 - Четверг, 15.09.2016, 11:54
 
Ответить
Сообщение
смотрите строку с восклицательными знаками. Почитайте про 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
Дата добавления - 15.09.2016 в 11:49
Pelena Дата: Четверг, 15.09.2016, 12:17 | Сообщение № 11
Группа: Модераторы
Ранг: Экселист
Сообщений: 9839
Репутация: 2252 ±
Замечаний: 0% ±

Excel 2010 & Mac Excel 2011
выдает ошибку

Какую? На какой строчке?

У меня макрос отработал нормально.


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщение
выдает ошибку

Какую? На какой строчке?

У меня макрос отработал нормально.

Автор - Pelena
Дата добавления - 15.09.2016 в 12:17
AVI Дата: Четверг, 15.09.2016, 12:27 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Pelena, простите!! Сам затупил!!!
смотрите строку с восклицательными знаками. Почитайте про Sheets, вместо номера листа можно указать его имя (name) или обращаться к листу по кодовому имени (codeName)

Спасибо!
 
Ответить
СообщениеPelena, простите!! Сам затупил!!!
смотрите строку с восклицательными знаками. Почитайте про Sheets, вместо номера листа можно указать его имя (name) или обращаться к листу по кодовому имени (codeName)

Спасибо!

Автор - AVI
Дата добавления - 15.09.2016 в 12:27
AVI Дата: Четверг, 22.09.2016, 12:21 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Manyasha, А что бы мне добавить еще одно место куда нужно перенести информацию из ячейки A26 с затиранием предыдущей записи мне нужно создать новую переменную?


Сообщение отредактировал AVI - Четверг, 22.09.2016, 12:47
 
Ответить
СообщениеManyasha, А что бы мне добавить еще одно место куда нужно перенести информацию из ячейки A26 с затиранием предыдущей записи мне нужно создать новую переменную?

Автор - AVI
Дата добавления - 22.09.2016 в 12:21
AVI Дата: Четверг, 22.09.2016, 18:54 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 6 ±
Замечаний: 0% ±

Excel 2013
Решил проблему несколько коряво, но работает
[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
[/vba]

Автор - AVI
Дата добавления - 22.09.2016 в 18:54
Manyasha Дата: Пятница, 23.09.2016, 10:26 | Сообщение № 15
Группа: Модераторы
Ранг: Старожил
Сообщений: 1582
Репутация: 659 ±
Замечаний: 0% ±

Excel 2007, 2010
AVI,
добавить еще одно место куда нужно перенести информацию из ячейки 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]
Код
sh1.Cells(26, "b") = sh1.Cells(26, "a")
[/vba]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеAVI,
добавить еще одно место куда нужно перенести информацию из ячейки 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]
Код
sh1.Cells(26, "b") = sh1.Cells(26, "a")
[/vba]

Автор - Manyasha
Дата добавления - 23.09.2016 в 10:26
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоматич. перенос стоки в другую книгу в свободную строку. (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!