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

Вход

Регистрация

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

 

= Мир MS Excel/Импорт данных из листа книги по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Импорт данных из листа книги по условию (Макросы/Sub)
Импорт данных из листа книги по условию
KolyvanOFF Дата: Четверг, 26.03.2015, 10:46 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 217
Репутация: 7 ±
Замечаний: 60% ±

Excel 2010
Добрый день.
В очередной раз прошу помощи. Задача такова, есть файл в который нужно импортировать прайс. В файле источнике на каждом листе прайс для определенного города. Необходимо чтобы макрос распознавал название листа которое есть в ячейке К1 и копировал с него данные. Образец файла приложить не могу из-за большого веса.
[vba]
Код
Sub ÎáíîâëåíèåÏðàéñà()
Dim MyPath As String
Dim wb1 As String
Dim wb2 As String
Application.ScreenUpdating = False
Application.CutCopyMode = False
wb1 = "Ïðàéñ.xls"
wb2 = "Êîììåð÷åñêîå ïðåäëîæåíèå.xlsm"
MyPath = ThisWorkbook.Path & "\" & wb1
Columns("A:I").ClearContents
Workbooks.Open Filename:=MyPath
Sheets = K1
Columns("A:J").Copy
Workbooks(wb2).Activate
Columns("A:J").PasteSpecial xlPasteAll
Workbooks(wb1).Activate
Application.CutCopyMode = True
Application.ScreenUpdating = True
ActiveWindow.Close
End Sub
[/vba]
[moder]Евгений, когда копируете код, включайте русскую раскладку, чтобы не было кракозябр[/moder]

С уважением, Евгений
 
Ответить
СообщениеДобрый день.
В очередной раз прошу помощи. Задача такова, есть файл в который нужно импортировать прайс. В файле источнике на каждом листе прайс для определенного города. Необходимо чтобы макрос распознавал название листа которое есть в ячейке К1 и копировал с него данные. Образец файла приложить не могу из-за большого веса.
[vba]
Код
Sub ÎáíîâëåíèåÏðàéñà()
Dim MyPath As String
Dim wb1 As String
Dim wb2 As String
Application.ScreenUpdating = False
Application.CutCopyMode = False
wb1 = "Ïðàéñ.xls"
wb2 = "Êîììåð÷åñêîå ïðåäëîæåíèå.xlsm"
MyPath = ThisWorkbook.Path & "\" & wb1
Columns("A:I").ClearContents
Workbooks.Open Filename:=MyPath
Sheets = K1
Columns("A:J").Copy
Workbooks(wb2).Activate
Columns("A:J").PasteSpecial xlPasteAll
Workbooks(wb1).Activate
Application.CutCopyMode = True
Application.ScreenUpdating = True
ActiveWindow.Close
End Sub
[/vba]
[moder]Евгений, когда копируете код, включайте русскую раскладку, чтобы не было кракозябр[/moder]
Автор - KolyvanOFF
Дата добавления - 26.03.2015 в 10:46
KolyvanOFF Дата: Четверг, 26.03.2015, 10:52 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 217
Репутация: 7 ±
Замечаний: 60% ±

Excel 2010
Принято! Продублировать код?
[moder]Вы лучше файл покоцайте и кусок сюда положите.
Ну и код заодно поправите

С уважением, Евгений
 
Ответить
СообщениеПринято! Продублировать код?
[moder]Вы лучше файл покоцайте и кусок сюда положите.
Ну и код заодно поправите
Автор - KolyvanOFF
Дата добавления - 26.03.2015 в 10:52
Roman777 Дата: Четверг, 26.03.2015, 10:56 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Добрый день, KolyvanOFF, Продублируй пожалуйста, виднее всем будет))) только чтобы по-русски было.

Много чего не знаю!!!!
 
Ответить
СообщениеДобрый день, KolyvanOFF, Продублируй пожалуйста, виднее всем будет))) только чтобы по-русски было.
Автор - Roman777
Дата добавления - 26.03.2015 в 10:56
Manyasha Дата: Четверг, 26.03.2015, 11:00 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 902 ±
Замечаний: 0% ±

Excel 2010, 2016
KolyvanOFF, попробуйте так:
[vba]
Код
Sub import()
     Dim MyPath As String
     Dim wb1 As String
     Dim wb2 As String
     Application.ScreenUpdating = False
     Application.CutCopyMode = False
     wb1 = "прайс.xls"
     wb2 = "еще_что-то.xlsm"
     MyPath = ThisWorkbook.Path & "\" & wb1
     Columns("A:I").ClearContents
      
     shName = ActiveSheet.Cells(1, 11).Value 'в данном случае значение К1 берется с активного листа в wb2
     Workbooks.Open Filename:=MyPath
     ActiveWorkbook.Sheets(shName).Select 'выбираем лист в wb1 с именем shName
      
     Columns("A:J").Copy
     Workbooks(wb2).Activate
     Columns("A:J").PasteSpecial xlPasteAll
     Workbooks(wb1).Activate
     Application.CutCopyMode = True
     Application.ScreenUpdating = True
     ActiveWindow.Close
End Sub
[/vba]

ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеKolyvanOFF, попробуйте так:
[vba]
Код
Sub import()
     Dim MyPath As String
     Dim wb1 As String
     Dim wb2 As String
     Application.ScreenUpdating = False
     Application.CutCopyMode = False
     wb1 = "прайс.xls"
     wb2 = "еще_что-то.xlsm"
     MyPath = ThisWorkbook.Path & "\" & wb1
     Columns("A:I").ClearContents
      
     shName = ActiveSheet.Cells(1, 11).Value 'в данном случае значение К1 берется с активного листа в wb2
     Workbooks.Open Filename:=MyPath
     ActiveWorkbook.Sheets(shName).Select 'выбираем лист в wb1 с именем shName
      
     Columns("A:J").Copy
     Workbooks(wb2).Activate
     Columns("A:J").PasteSpecial xlPasteAll
     Workbooks(wb1).Activate
     Application.CutCopyMode = True
     Application.ScreenUpdating = True
     ActiveWindow.Close
End Sub
[/vba]
Автор - Manyasha
Дата добавления - 26.03.2015 в 11:00
KolyvanOFF Дата: Четверг, 26.03.2015, 11:04 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 217
Репутация: 7 ±
Замечаний: 60% ±

Excel 2010
[vba]
Код
Sub Price()
Dim MyPath As String
Dim wb1 As String
Dim wb2 As String
Application.ScreenUpdating = False
Application.CutCopyMode = False
wb1 = "Prise.xls"
wb2 = "KP.xlsm"
MyPath = ThisWorkbook.Path & "\" & wb1
Columns("A:I").ClearContents
Workbooks.Open Filename:=MyPath
Sheets = K1
Columns("A:J").Copy
Workbooks(wb2).Activate
Columns("A:J").PasteSpecial xlPasteAll
Workbooks(wb1).Activate
Application.CutCopyMode = True
Application.ScreenUpdating = True
ActiveWindow.Close
End Sub
[/vba]
К сообщению приложен файл: RG.xlsm (66.3 Kb)

С уважением, Евгений
 
Ответить
Сообщение[vba]
Код
Sub Price()
Dim MyPath As String
Dim wb1 As String
Dim wb2 As String
Application.ScreenUpdating = False
Application.CutCopyMode = False
wb1 = "Prise.xls"
wb2 = "KP.xlsm"
MyPath = ThisWorkbook.Path & "\" & wb1
Columns("A:I").ClearContents
Workbooks.Open Filename:=MyPath
Sheets = K1
Columns("A:J").Copy
Workbooks(wb2).Activate
Columns("A:J").PasteSpecial xlPasteAll
Workbooks(wb1).Activate
Application.CutCopyMode = True
Application.ScreenUpdating = True
ActiveWindow.Close
End Sub
[/vba]
Автор - KolyvanOFF
Дата добавления - 26.03.2015 в 11:04
_Boroda_ Дата: Четверг, 26.03.2015, 11:15 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 16957
Репутация: 6631 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Вместо вот этого
[vba]
Код
Sheets = K1
Columns("A:J").Copy
Workbooks(wb2).Activate
Columns("A:J").PasteSpecial xlPasteAll
Workbooks(wb1).Activate
Application.CutCopyMode = True
[/vba]
напишите
[vba]
Код
shName=ThisWorkbook.ActiveSheet.Range("K1")   
ActiveWorkbook.Sheets(shName).Columns("A:J").Copy ThisWorkbook.ActiveSheet.Range("A1")
[/vba]
Целиком примерно так (возможно, где-то перепутки с книгами, но суть, я думаю, ясна):
[vba]
Код
Sub Price()
     Application.ScreenUpdating = False
     wb1 = "Prise.xls"
     wb2 = "KP.xlsm"
     MyPath = ThisWorkbook.Path & "\" & wb1
     sn_ = [K1]
     Workbooks.Open Filename:=MyPath
     ActiveWorkbook.Sheets(sn_).Columns("A:J").Copy Workbooks(wb2).ActiveSheet.Range("A1")
     Application.ScreenUpdating = True
     ActiveWindow.Close
End Sub
[/vba]
[p.s.]Не стОит обзывать переменную "Sheets". Такое слово в VBA уже есть.[/p.s.]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеВместо вот этого
[vba]
Код
Sheets = K1
Columns("A:J").Copy
Workbooks(wb2).Activate
Columns("A:J").PasteSpecial xlPasteAll
Workbooks(wb1).Activate
Application.CutCopyMode = True
[/vba]
напишите
[vba]
Код
shName=ThisWorkbook.ActiveSheet.Range("K1")   
ActiveWorkbook.Sheets(shName).Columns("A:J").Copy ThisWorkbook.ActiveSheet.Range("A1")
[/vba]
Целиком примерно так (возможно, где-то перепутки с книгами, но суть, я думаю, ясна):
[vba]
Код
Sub Price()
     Application.ScreenUpdating = False
     wb1 = "Prise.xls"
     wb2 = "KP.xlsm"
     MyPath = ThisWorkbook.Path & "\" & wb1
     sn_ = [K1]
     Workbooks.Open Filename:=MyPath
     ActiveWorkbook.Sheets(sn_).Columns("A:J").Copy Workbooks(wb2).ActiveSheet.Range("A1")
     Application.ScreenUpdating = True
     ActiveWindow.Close
End Sub
[/vba]
[p.s.]Не стОит обзывать переменную "Sheets". Такое слово в VBA уже есть.[/p.s.]
Автор - _Boroda_
Дата добавления - 26.03.2015 в 11:15
KolyvanOFF Дата: Четверг, 26.03.2015, 11:27 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 217
Репутация: 7 ±
Замечаний: 60% ±

Excel 2010
Manyasha, _Boroda_, Огромное спасибо за оперативность. Все работает как часы.

С уважением, Евгений
 
Ответить
СообщениеManyasha, _Boroda_, Огромное спасибо за оперативность. Все работает как часы.
Автор - KolyvanOFF
Дата добавления - 26.03.2015 в 11:27
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Импорт данных из листа книги по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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