Здравствуйте! Объединение эксель-файлов - это здорово, но... нет предела совершенству Друзья, помогите организовать такой макрос: нужно из текущего открытого документа скопировать все данные, кроме первой строки и в ставить их по адресу D:\XXX\09(номер текущего месяца)\общ\Документ.xlsx Данные должны добавляться в конец "Документ.xlsx", а не заменяться. таблица всегда однотипна Не судите строго работа с отдельными книгами и листами пока ещё вызывает затруднения...
Здравствуйте! Объединение эксель-файлов - это здорово, но... нет предела совершенству Друзья, помогите организовать такой макрос: нужно из текущего открытого документа скопировать все данные, кроме первой строки и в ставить их по адресу D:\XXX\09(номер текущего месяца)\общ\Документ.xlsx Данные должны добавляться в конец "Документ.xlsx", а не заменяться. таблица всегда однотипна Не судите строго работа с отдельными книгами и листами пока ещё вызывает затруднения...emkub
нужно из текущего открытого документа скопировать все данные, кроме первой строки
я как раз таки поднимал похожую тему и аж набралось три листа обсуждений и понимания этого действия (((( тяжело но сделать можно. My WebPage там как раз за копирование с одного листа на множество других листов (с разными параметрами и столбцами). А вот чтоб в нужный вам файл это можно путь и самому попытаться прописать через ЗАПИСЬ МАКРОСА потом его вытянуть и вставить в тот код с копированием.
emkub,
Цитата
нужно из текущего открытого документа скопировать все данные, кроме первой строки
я как раз таки поднимал похожую тему и аж набралось три листа обсуждений и понимания этого действия (((( тяжело но сделать можно. My WebPage там как раз за копирование с одного листа на множество других листов (с разными параметрами и столбцами). А вот чтоб в нужный вам файл это можно путь и самому попытаться прописать через ЗАПИСЬ МАКРОСА потом его вытянуть и вставить в тот код с копированием.lebensvoll
Читал вашу тему, но честно говоря, практически ничего не понял, что вы хотели сделать Сейчас буду смотреть внимательнее. А записью макроса пробую всегда в первую очередь. Но тут и близко не то.
Читал вашу тему, но честно говоря, практически ничего не понял, что вы хотели сделать Сейчас буду смотреть внимательнее. А записью макроса пробую всегда в первую очередь. Но тут и близко не то.emkub
Сообщение отредактировал emkub - Вторник, 20.09.2016, 22:04
Скажу откровенно по опыту. Вы выкладывайте ваши старания как получилось. Народ вас подправит (я в этом уверен). А вот если создали тему и ждете когда за вас ее кто сделает, то вам будут предлагать перейти во фриланс. Тем самым (если вы хоть как то стараетесь и пытаетесь понять) народ это видит и поверьте помогает (ну иногда и ругает что подтормаживаешь ))))). Так что не стесняйтесь выкладывайте ваши старания в свет. Вам обязательно помогут скорректируют ваши действия
Скажу откровенно по опыту. Вы выкладывайте ваши старания как получилось. Народ вас подправит (я в этом уверен). А вот если создали тему и ждете когда за вас ее кто сделает, то вам будут предлагать перейти во фриланс. Тем самым (если вы хоть как то стараетесь и пытаетесь понять) народ это видит и поверьте помогает (ну иногда и ругает что подтормаживаешь ))))). Так что не стесняйтесь выкладывайте ваши старания в свет. Вам обязательно помогут скорректируют ваши действияlebensvoll
Даже мне видно, что мои "старания" выглядят полнейшей ахинеей стыдно такое выкладывать. Ничего, я с этим только третий день воюю. Через месяцок вид будет лучше Однако, ваш макрос с пояснениями подталкивает в нужную сторону.
Даже мне видно, что мои "старания" выглядят полнейшей ахинеей стыдно такое выкладывать. Ничего, я с этим только третий день воюю. Через месяцок вид будет лучше Однако, ваш макрос с пояснениями подталкивает в нужную сторону.emkub
Сообщение отредактировал emkub - Вторник, 20.09.2016, 22:38
Sub copyData() With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With Dim sh1 As Worksheet, wbOpen As Workbook Dim lr1 As Long, lc1 As Long, lr2 As Long Dim wbPath As String Set sh1 = ThisWorkbook.Sheets(1) 'Путь книге, в которую копируем wbPath = "D:\XXX\" & Format(Month(Now), "00") & "\общ\Документ.xlsx" 'последняя строка в исходной книге (по 1-му столбцу) lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'последний столбец в исходной книге (по 1-й строке) lc1 = sh1.Cells(1, Columns.Count).End(xlToLeft).Column
Set wbOpen = Workbooks.Open(wbPath) With wbOpen.Sheets(1) 'последняя строка в новой книге (wbOpen) по 1-му столбцу +1 lr2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1 'копируем Range(sh1.Cells(2, 1), sh1.Cells(lr1, lc1)).Copy Range(.Cells(lr2, 1), .Cells(lr2 + lr1 - 1, lc1)) End With wbOpen.Close True With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With End Sub
[/vba]
emkub, Здравствуйте, например, так можно: [vba]
Код
Sub copyData() With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With Dim sh1 As Worksheet, wbOpen As Workbook Dim lr1 As Long, lc1 As Long, lr2 As Long Dim wbPath As String Set sh1 = ThisWorkbook.Sheets(1) 'Путь книге, в которую копируем wbPath = "D:\XXX\" & Format(Month(Now), "00") & "\общ\Документ.xlsx" 'последняя строка в исходной книге (по 1-му столбцу) lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'последний столбец в исходной книге (по 1-й строке) lc1 = sh1.Cells(1, Columns.Count).End(xlToLeft).Column
Set wbOpen = Workbooks.Open(wbPath) With wbOpen.Sheets(1) 'последняя строка в новой книге (wbOpen) по 1-му столбцу +1 lr2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1 'копируем Range(sh1.Cells(2, 1), sh1.Cells(lr1, lc1)).Copy Range(.Cells(lr2, 1), .Cells(lr2 + lr1 - 1, lc1)) End With wbOpen.Close True With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With End Sub
[/vba], т.к. макрос живёт в одной книге, а работает в другой. И заработала как надо !!! Manyasha, одно спасибо за сам код! И отдельное спасибо - за комментарии в нём! Когда оно написано и расписано - кажется ТАК всё легко и понятно. А когда сам мудришь...ммм, не так понятно...
Заменил [vba]
Код
Set sh1 = ThisWorkbook.Sheets(1)
[/vba] на [vba]
Код
Set sh1 = ActiveWorkbook.Sheets(1)
[/vba], т.к. макрос живёт в одной книге, а работает в другой. И заработала как надо !!! Manyasha, одно спасибо за сам код! И отдельное спасибо - за комментарии в нём! Когда оно написано и расписано - кажется ТАК всё легко и понятно. А когда сам мудришь...ммм, не так понятно...emkub
Здравствуйте, Марина! Надеюсь увидите моё сообщение Пытаюсь понять, как подправить ваш макрос, если тот файл, в который нужно копировать, уже открыт. Но что-то не разберусь... Макрос просто делает его активным и всё. Помогите пожалуйста
Здравствуйте, Марина! Надеюсь увидите моё сообщение Пытаюсь понять, как подправить ваш макрос, если тот файл, в который нужно копировать, уже открыт. Но что-то не разберусь... Макрос просто делает его активным и всё. Помогите пожалуйста emkub
Марины на форуме с понедельника нет, попробую за нее (кстати, Евгений, обращаясь к конкретному человеку, Вы рискуете тем, что придется довольно долго его ждать). В коде ничего не менял, кроме того, что нужно для работы с уже открытой книгой [vba]
Код
Sub copyData() With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With Dim sh1 As Worksheet, wbOpen As Workbook Dim lr1 As Long, lc1 As Long, lr2 As Long Set sh1 = ThisWorkbook.Sheets(1) lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row lc1 = sh1.Cells(1, Columns.Count).End(xlToLeft).Column Set wbOpen = Workbooks("Äîêóìåíò.xlsx") With wbOpen.Sheets(1) .Activate lr2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1 Range(sh1.Cells(2, 1), sh1.Cells(lr1, lc1)).Copy Range(.Cells(lr2, 1), .Cells(lr2 + lr1 - 1, lc1)) End With With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With End Sub
[/vba]
Марины на форуме с понедельника нет, попробую за нее (кстати, Евгений, обращаясь к конкретному человеку, Вы рискуете тем, что придется довольно долго его ждать). В коде ничего не менял, кроме того, что нужно для работы с уже открытой книгой [vba]
Код
Sub copyData() With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With Dim sh1 As Worksheet, wbOpen As Workbook Dim lr1 As Long, lc1 As Long, lr2 As Long Set sh1 = ThisWorkbook.Sheets(1) lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row lc1 = sh1.Cells(1, Columns.Count).End(xlToLeft).Column Set wbOpen = Workbooks("Äîêóìåíò.xlsx") With wbOpen.Sheets(1) .Activate lr2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1 Range(sh1.Cells(2, 1), sh1.Cells(lr1, lc1)).Copy Range(.Cells(lr2, 1), .Cells(lr2 + lr1 - 1, lc1)) End With With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
работа с отдельными книгами и листами пока ещё вызывает затруднения...
стыдно такое выкладывать.
