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

Вход

Регистрация

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

 

= Мир MS Excel/Копирование определенных ячеек из одной книги в другую. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование определенных ячеек из одной книги в другую. (Макросы/Sub)
Копирование определенных ячеек из одной книги в другую.
ПалычЪ Дата: Воскресенье, 22.11.2015, 15:24 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 106
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Добрый день! Вопрос: как нужно переписать макрос в файле КУДА, что бы копировались только желтые ячейки файла ОТКУДА в файл КУДА которые идут до строки ИТОГО. Файл ОТКУДА может прийти с любым количеством строк каждый раз(то есть неизвестно где будет строка итого ((. . Заранее спасибо!
П.С оба файла будут лежать в одной папке. Макрос то уже работает...но только копирует строго заданный диапазон...а вот как сделать чтобы копируемый диапазон автоматом задавался до строки ИТОГО..
Что бы все вышеописанное случилось нужно в одной папке иметь ОБА файла, при чем файл ОТКУДА и должен называться именно ОТКУДА. А можно сделать так что б файл каждый раз мне не переименовывать на ОТКУДА....так как каждый приходящий файл по разному называется....как дополнить этот макрос ..чтоб просто кидаешь в папку файл где уже находится файл КУДА и его не нужно переименовывать в файл ОТКУДА.

Это файл ОТКУДА
К сообщению приложен файл: 5695932.xlsx (10.7 Kb)


Сообщение отредактировал ПалычЪ - Воскресенье, 22.11.2015, 17:03
 
Ответить
СообщениеДобрый день! Вопрос: как нужно переписать макрос в файле КУДА, что бы копировались только желтые ячейки файла ОТКУДА в файл КУДА которые идут до строки ИТОГО. Файл ОТКУДА может прийти с любым количеством строк каждый раз(то есть неизвестно где будет строка итого ((. . Заранее спасибо!
П.С оба файла будут лежать в одной папке. Макрос то уже работает...но только копирует строго заданный диапазон...а вот как сделать чтобы копируемый диапазон автоматом задавался до строки ИТОГО..
Что бы все вышеописанное случилось нужно в одной папке иметь ОБА файла, при чем файл ОТКУДА и должен называться именно ОТКУДА. А можно сделать так что б файл каждый раз мне не переименовывать на ОТКУДА....так как каждый приходящий файл по разному называется....как дополнить этот макрос ..чтоб просто кидаешь в папку файл где уже находится файл КУДА и его не нужно переименовывать в файл ОТКУДА.

Это файл ОТКУДА
Автор - ПалычЪ
Дата добавления - 22.11.2015 в 15:24
ПалычЪ Дата: Воскресенье, 22.11.2015, 15:29 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 106
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
файл КУДА
К сообщению приложен файл: 6561087.xlsm (19.0 Kb)


Сообщение отредактировал ПалычЪ - Воскресенье, 22.11.2015, 15:40
 
Ответить
Сообщениефайл КУДА
Автор - ПалычЪ
Дата добавления - 22.11.2015 в 15:29
_Boroda_ Дата: Воскресенье, 22.11.2015, 16:05 | Сообщение № 3
Группа: Админы
Ранг: Местный житель
Сообщений: 16711
Репутация: 6502 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Не переписывая Ваш код, просто добавил вторую строку
[vba]
Код
r1_ = Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A" & Rows.Count).End(xlUp).Row - 1
Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A2:B" & r1_).Copy
...
[/vba]

Добавлено.
Поправил. Забыл единичку вычесть
А вообще, переписать если, то можно так, например
[vba]
Код
Sub Название_Копи()
    Application.ScreenUpdating = 0
    Range(Range("B5"), Range("B5").SpecialCells(xlLastCell)).ClearContents
    Workbooks.Open Filename:=ThisWorkbook.Path & "\Откуда.xlsx"
    With Workbooks("Откуда.xlsx").Worksheets("Лист1")
        r1_ = .Range("A" & .Rows.Count).End(xlUp).Row - 1
        ThisWorkbook.Worksheets("Лист1").Range("B5").Resize(r1_ - 1, 2) = .Range("A2:B" & r1_).Value
        ThisWorkbook.Worksheets("Лист1").Range("D5").Resize(r1_ - 1) = .Range("E2:E" & r1_).Value
        Workbooks("Откуда.xlsx").Close
    End With
End Sub
[/vba]
К сообщению приложен файл: 6561087_2.xlsm (19.4 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеНе переписывая Ваш код, просто добавил вторую строку
[vba]
Код
r1_ = Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A" & Rows.Count).End(xlUp).Row - 1
Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A2:B" & r1_).Copy
...
[/vba]

Добавлено.
Поправил. Забыл единичку вычесть
А вообще, переписать если, то можно так, например
[vba]
Код
Sub Название_Копи()
    Application.ScreenUpdating = 0
    Range(Range("B5"), Range("B5").SpecialCells(xlLastCell)).ClearContents
    Workbooks.Open Filename:=ThisWorkbook.Path & "\Откуда.xlsx"
    With Workbooks("Откуда.xlsx").Worksheets("Лист1")
        r1_ = .Range("A" & .Rows.Count).End(xlUp).Row - 1
        ThisWorkbook.Worksheets("Лист1").Range("B5").Resize(r1_ - 1, 2) = .Range("A2:B" & r1_).Value
        ThisWorkbook.Worksheets("Лист1").Range("D5").Resize(r1_ - 1) = .Range("E2:E" & r1_).Value
        Workbooks("Откуда.xlsx").Close
    End With
End Sub
[/vba]
Автор - _Boroda_
Дата добавления - 22.11.2015 в 16:05
ПалычЪ Дата: Воскресенье, 22.11.2015, 16:27 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 106
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Спасибо теперь понял) все работает) + в репу
 
Ответить
СообщениеСпасибо теперь понял) все работает) + в репу
Автор - ПалычЪ
Дата добавления - 22.11.2015 в 16:27
ПалычЪ Дата: Воскресенье, 22.11.2015, 16:33 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 106
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Кстати Борода...а если не переписывать макрос а добавить что то в мой....еще раз плиз...что добавить и куда? Просто мой макрос я понимаю..твой нет (сложно для меня). На работе я просто перепишу его..диапазоны другие и т.д. будут.... мне тока б что б копировалось до строки Итого) минимум изменив мой макрос или минимум дописав его)


Сообщение отредактировал ПалычЪ - Воскресенье, 22.11.2015, 16:36
 
Ответить
СообщениеКстати Борода...а если не переписывать макрос а добавить что то в мой....еще раз плиз...что добавить и куда? Просто мой макрос я понимаю..твой нет (сложно для меня). На работе я просто перепишу его..диапазоны другие и т.д. будут.... мне тока б что б копировалось до строки Итого) минимум изменив мой макрос или минимум дописав его)
Автор - ПалычЪ
Дата добавления - 22.11.2015 в 16:33
_Boroda_ Дата: Воскресенье, 22.11.2015, 16:42 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 16711
Репутация: 6502 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Смотрите первые 3 строки моего первого ответа.
Целиком будет так
[vba]
Код
Sub Название_Копи()
Workbooks.Open Filename:="C:\Users\GTA\Desktop\Макросы\Откуда.xlsx"
r1_ = Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A" & Rows.Count).End(xlUp).Row - 1
Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A2:B" & r1_).Copy
Workbooks("Куда.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("B5").Select
ActiveSheet.Paste
Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("E2:E" & r1_).Copy
Workbooks("Куда.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("D5").Select
ActiveSheet.Paste
Workbooks("Откуда.xlsx").Close
End Sub
[/vba]
Если файл "Откуда" будет в старом формате(xls), то строку
[vba]
Код
r1_ = Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A" & Rows.Count).End(xlUp).Row - 1
[/vba]
перепишите так
[vba]
Код
r1_ = Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A" & Workbooks("Откуда.xlsx").Worksheets("Лист1").Rows.Count).End(xlUp).Row - 1
[/vba]
или так (не по фен-шую, но сойдет)
[vba]
Код
r1_ = Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A65000").End(xlUp).Row - 1
[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеСмотрите первые 3 строки моего первого ответа.
Целиком будет так
[vba]
Код
Sub Название_Копи()
Workbooks.Open Filename:="C:\Users\GTA\Desktop\Макросы\Откуда.xlsx"
r1_ = Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A" & Rows.Count).End(xlUp).Row - 1
Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A2:B" & r1_).Copy
Workbooks("Куда.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("B5").Select
ActiveSheet.Paste
Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("E2:E" & r1_).Copy
Workbooks("Куда.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("D5").Select
ActiveSheet.Paste
Workbooks("Откуда.xlsx").Close
End Sub
[/vba]
Если файл "Откуда" будет в старом формате(xls), то строку
[vba]
Код
r1_ = Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A" & Rows.Count).End(xlUp).Row - 1
[/vba]
перепишите так
[vba]
Код
r1_ = Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A" & Workbooks("Откуда.xlsx").Worksheets("Лист1").Rows.Count).End(xlUp).Row - 1
[/vba]
или так (не по фен-шую, но сойдет)
[vba]
Код
r1_ = Workbooks("Откуда.xlsx").Worksheets("Лист1").Range("A65000").End(xlUp).Row - 1
[/vba]
Автор - _Boroda_
Дата добавления - 22.11.2015 в 16:42
ПалычЪ Дата: Воскресенье, 22.11.2015, 16:47 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 106
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Борода не хочу наглеть) вторую тему не открыл, так, как и условие в этой теме изменил..дополнил точнее) Вопрос Что бы все вышеописанное случилось нужно в одной папке иметь ОБА файла, при чем файл ОТКУДА и должен называться именно ОТКУДА. А можно сделать так что б файл каждый раз мне не переименовывать на ОТКУДА....так как каждый приходящий файл по разному называется....как дополнить этот макрос ваш последний самый..чтоб просто кидаешь в папку файл где уже находится файл КУДА и его не нужно переименовывать в файл ОТКУДА. Заранее спасибо.


Сообщение отредактировал ПалычЪ - Воскресенье, 22.11.2015, 17:02
 
Ответить
СообщениеБорода не хочу наглеть) вторую тему не открыл, так, как и условие в этой теме изменил..дополнил точнее) Вопрос Что бы все вышеописанное случилось нужно в одной папке иметь ОБА файла, при чем файл ОТКУДА и должен называться именно ОТКУДА. А можно сделать так что б файл каждый раз мне не переименовывать на ОТКУДА....так как каждый приходящий файл по разному называется....как дополнить этот макрос ваш последний самый..чтоб просто кидаешь в папку файл где уже находится файл КУДА и его не нужно переименовывать в файл ОТКУДА. Заранее спасибо.
Автор - ПалычЪ
Дата добавления - 22.11.2015 в 16:47
_Boroda_ Дата: Воскресенье, 22.11.2015, 17:25 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 16711
Репутация: 6502 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Ловите. С учетом того, что в папке ТОЛЬКО ДВА ФАЙЛА.
[vba]
Код
Sub Название_Копи()
    Application.ScreenUpdating = False
    pap_ = ThisWorkbook.Path & "\"
    fil_ = Dir(pap_ & "*.xls*")
    If fil_ = ThisWorkbook.Name Then fil_ = Dir
    Workbooks.Open Filename:=pap_ & fil_

Workbooks(fil_).Worksheets("Лист1").Range("A2:B14").Copy
Workbooks("Куда.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("B5").Select
ActiveSheet.Paste
Workbooks(fil_).Worksheets("Лист1").Range("E2:E14").Copy
Workbooks("Куда.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("D5").Select
ActiveSheet.Paste
Workbooks(fil_).Close
End Sub
[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЛовите. С учетом того, что в папке ТОЛЬКО ДВА ФАЙЛА.
[vba]
Код
Sub Название_Копи()
    Application.ScreenUpdating = False
    pap_ = ThisWorkbook.Path & "\"
    fil_ = Dir(pap_ & "*.xls*")
    If fil_ = ThisWorkbook.Name Then fil_ = Dir
    Workbooks.Open Filename:=pap_ & fil_

Workbooks(fil_).Worksheets("Лист1").Range("A2:B14").Copy
Workbooks("Куда.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("B5").Select
ActiveSheet.Paste
Workbooks(fil_).Worksheets("Лист1").Range("E2:E14").Copy
Workbooks("Куда.xlsm").Activate
ActiveWorkbook.Worksheets("Лист1").Range("D5").Select
ActiveSheet.Paste
Workbooks(fil_).Close
End Sub
[/vba]
Автор - _Boroda_
Дата добавления - 22.11.2015 в 17:25
ПалычЪ Дата: Воскресенье, 22.11.2015, 17:27 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 106
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
СпасибО))
 
Ответить
СообщениеСпасибО))
Автор - ПалычЪ
Дата добавления - 22.11.2015 в 17:27
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование определенных ячеек из одной книги в другую. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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