Добрый день, есть список, его сотрудники пополняют и в конце рабочего дня они выделяют все записи за день и нажимаю кнопку, запись выделенного (на нем макрос) суть макроса копирование выделенной области на др лист (уже сделал) и копирование выделенных данных в отдельный файл и его пополнение (не сделал) и хочу еще отчищать раб область (лист куда сотрудники в течение дня вводят записи). Очень нужна ваша помощь Макросы эксель только начал изучать.
Добрый день, есть список, его сотрудники пополняют и в конце рабочего дня они выделяют все записи за день и нажимаю кнопку, запись выделенного (на нем макрос) суть макроса копирование выделенной области на др лист (уже сделал) и копирование выделенных данных в отдельный файл и его пополнение (не сделал) и хочу еще отчищать раб область (лист куда сотрудники в течение дня вводят записи). Очень нужна ваша помощь Макросы эксель только начал изучать.
Ваш файл не смотрел (у меня на работе сисадмины, собаки, скачивать файлы с макросами запретили). Но посмотрите, в топике Макрос "Copy_ROWs_to_EXT_FILE" не то, что Вам нужно?
Ваш файл не смотрел (у меня на работе сисадмины, собаки, скачивать файлы с макросами запретили). Но посмотрите, в топике Макрос "Copy_ROWs_to_EXT_FILE" не то, что Вам нужно?Alex_ST
If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With Set wb = GetObject("c:\test.xls") 'путь к файлу-накопителю Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) wb.Close (True) ' закрыть с сохранением With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing
[/vba]
копирует замечательно, но копирует всю строку а не выделенную область.
хотел объединить мое копирование в лист и ваше в файл не получилось
[vba]
Код
Sub ЗаписьВОбщийЖурнал() ' ' Макрос2 Макрос ' Макрос записан 15.10.2007 (VladimirovAV) '
If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With Set wb = GetObject("c:\test.xls") 'путь к файлу-накопителю Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) wb.Close (True) ' закрыть с сохранением With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing
End Sub
[/vba]
отказывается копировать
понял вас, значит так по скрипту вашему
[vba]
Код
If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With Set wb = GetObject("c:\test.xls") 'путь к файлу-накопителю Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) wb.Close (True) ' закрыть с сохранением With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing
[/vba]
копирует замечательно, но копирует всю строку а не выделенную область.
хотел объединить мое копирование в лист и ваше в файл не получилось
[vba]
Код
Sub ЗаписьВОбщийЖурнал() ' ' Макрос2 Макрос ' Макрос записан 15.10.2007 (VladimirovAV) '
If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With Set wb = GetObject("c:\test.xls") 'путь к файлу-накопителю Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) wb.Close (True) ' закрыть с сохранением With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing
If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With Set wb = GetObject("c:\test.xls") 'ïóòü ê ôàéëó-íàêîïèòåëþ Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.Copy wb.Sheets(1).Cells(lr + 1, 1) wb.Close (True) ' çàêðûòü ñ ñîõðàíåíèåì With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing
[/vba] [admin]aydar,оформляйте коды тегами и копируйте их из VBA при русской раскладке[/admin]
If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With Set wb = GetObject("c:\test.xls") 'ïóòü ê ôàéëó-íàêîïèòåëþ Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.Copy wb.Sheets(1).Cells(lr + 1, 1) wb.Close (True) ' çàêðûòü ñ ñîõðàíåíèåì With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing
[/vba] [admin]aydar,оформляйте коды тегами и копируйте их из VBA при русской раскладке[/admin]aydar
' это копирования выделения в другой файл If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With Set wb = GetObject("c:\test.xls") 'путь к файлу-накопителю Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.Copy wb.Sheets(1).Cells(lr + 1, 1) wb.Close (True) ' закрыть с сохранением With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing
End Sub
копирование в другой файл работает криво, копируется вся строка а не выделение,иногда не все данные копируются
' это копирования выделения в другой файл If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With Set wb = GetObject("c:\test.xls") 'путь к файлу-накопителю Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.Copy wb.Sheets(1).Cells(lr + 1, 1) wb.Close (True) ' закрыть с сохранением With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing
End Sub
копирование в другой файл работает криво, копируется вся строка а не выделение,иногда не все данные копируютсяaydar
Ну вот, зарегистрировались, теперь можно и попытаться разобраться.
У меня на моих файлах работает. Но у меня макрос уже "допиленный" Проблема может быть в структуре данных. Например, в приведённом Вами фрагменте кода lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row определяет ряд с первой пустой ячейкой В ПЕРВОМ СТОЛБЦЕ. Поэтому если Вы копируете диапазон, где в ячейках первого столбца есть пустые, то lr определится не правильно и следующая запись наложится на предыдущую. Об этом, к стати, всё расписано в том топике, откуда Вы брали фрагмент. Вы дальше первого топика читали? Ну, например, ЭТО.
Приложите пример. Тогда кто-нибудь попробует разобраться почему у Вас не работает. (Я не смогу - на работе завал, да ещё и сисадмины закрыли скачивание файлов с макросами, собаки!)
Ну вот, зарегистрировались, теперь можно и попытаться разобраться.
У меня на моих файлах работает. Но у меня макрос уже "допиленный" Проблема может быть в структуре данных. Например, в приведённом Вами фрагменте кода lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row определяет ряд с первой пустой ячейкой В ПЕРВОМ СТОЛБЦЕ. Поэтому если Вы копируете диапазон, где в ячейках первого столбца есть пустые, то lr определится не правильно и следующая запись наложится на предыдущую. Об этом, к стати, всё расписано в том топике, откуда Вы брали фрагмент. Вы дальше первого топика читали? Ну, например, ЭТО.
Приложите пример. Тогда кто-нибудь попробует разобраться почему у Вас не работает. (Я не смогу - на работе завал, да ещё и сисадмины закрыли скачивание файлов с макросами, собаки!)Alex_ST
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
