Спасибо всем за ответы, постараюсь догнать о чем RAN и Hugo выше написали, я понимаю что в этом проблема Set wb1 = ActiveWorkbook, пробовал без Active указывать все равно не хочет работать.
Спасибо всем за ответы, постараюсь догнать о чем RAN и Hugo выше написали, я понимаю что в этом проблема Set wb1 = ActiveWorkbook, пробовал без Active указывать все равно не хочет работать.Xaden
Так Вы и не рассказали что хотели сделать. Может это? [vba]
Код
Sub Макрос1() Dim wb1 As Workbook, wb2 As Workbook, sh2 As Worksheet
Set wb2 = ActiveWorkbook Set wb1 = Workbooks.Open(Filename:=Application.GetOpenFilename) Set sh2 = wb2.Sheets(1)
Application.ScreenUpdating = False
With wb1.Sheets(1) .UsedRange.Value = .UsedRange.Value .Range("$A$7:$EL$19984").AutoFilter Field:=1, Criteria1:= _ "первый", Operator:=xlOr .Columns("A:AP").Copy sh2.Range("A1") End With
wb1.Close 0 End Sub
[/vba]
Так Вы и не рассказали что хотели сделать. Может это? [vba]
Код
Sub Макрос1() Dim wb1 As Workbook, wb2 As Workbook, sh2 As Worksheet
Set wb2 = ActiveWorkbook Set wb1 = Workbooks.Open(Filename:=Application.GetOpenFilename) Set sh2 = wb2.Sheets(1)
Application.ScreenUpdating = False
With wb1.Sheets(1) .UsedRange.Value = .UsedRange.Value .Range("$A$7:$EL$19984").AutoFilter Field:=1, Criteria1:= _ "первый", Operator:=xlOr .Columns("A:AP").Copy sh2.Range("A1") End With
Так Вы и не рассказали что хотели сделать. Может это?
Прошу прощения, но вроде как выше описывал, что мне надо было копировать данные с одного файла в другой. Но была проблема с открывающемся файлом с которого надо было переносить данные. Простите коряво наверно объясняю, что хотел сделать. Но в целом вы угадали Вот возник еще вопрос, буду благодарен если подскажите, у меня копируются только значения, возможно как то сделать, что бы и копировались формулы где они есть?
Так Вы и не рассказали что хотели сделать. Может это?
Прошу прощения, но вроде как выше описывал, что мне надо было копировать данные с одного файла в другой. Но была проблема с открывающемся файлом с которого надо было переносить данные. Простите коряво наверно объясняю, что хотел сделать. Но в целом вы угадали Вот возник еще вопрос, буду благодарен если подскажите, у меня копируются только значения, возможно как то сделать, что бы и копировались формулы где они есть?Xaden
Помогите пжл, я уже перерыл кучу инфы, но ничего не могу поделать, уже рыскался в скрытых формулах и защищенных ячейках, один фиг не переносит формулы. Попробовал просто с файла в фаил перенести данные с формулами выходит такая фигня см.вложение
Помогите пжл, я уже перерыл кучу инфы, но ничего не могу поделать, уже рыскался в скрытых формулах и защищенных ячейках, один фиг не переносит формулы. Попробовал просто с файла в фаил перенести данные с формулами выходит такая фигня см.вложениеXaden
Dim wb1 As Workbook, wb2 As Workbook Dim SStr As String Dim Ci As Long, Cj As Long
Set wb1 = ActiveWorkbook Workbooks.Open Filename:=Application.GetOpenFilename Set wb2 = ActiveWorkbook
SStr = wb1.Sheets(1).Cells(3, 7) Ci = 1 Cj = 1 wb1.Sheets(2).Cells.Clear Do While wb2.Sheets(1).Cells(Ci, 1) <> "" If InStr(1, wb2.Sheets(1).Cells(Ci, 1), SStr, 1) Then wb2.Sheets(1).Rows(Ci).Copy wb1.Sheets(2).Activate Rows(Cj).Select ActiveSheet.Paste Cj = Cj + 1 End If Ci = Ci + 1 Loop
Application.CutCopyMode = False wb2.Close SaveChanges:=False Application.ScreenUpdating = True End Sub
[/vba]
Возникла трудность в работе макроса, в столбце где происходит поиск значения есть пустые ячейки, и макрос прекращает сразу работу как только натыкается на пустую ячейку, возможно ка кто исправить данный факт или же в файле исходника надо удалять пустые ячейки для корректной работы данного макроса?
[vba]
Код
Sub Макрос1() Application.ScreenUpdating = False
Dim wb1 As Workbook, wb2 As Workbook Dim SStr As String Dim Ci As Long, Cj As Long
Set wb1 = ActiveWorkbook Workbooks.Open Filename:=Application.GetOpenFilename Set wb2 = ActiveWorkbook
SStr = wb1.Sheets(1).Cells(3, 7) Ci = 1 Cj = 1 wb1.Sheets(2).Cells.Clear Do While wb2.Sheets(1).Cells(Ci, 1) <> "" If InStr(1, wb2.Sheets(1).Cells(Ci, 1), SStr, 1) Then wb2.Sheets(1).Rows(Ci).Copy wb1.Sheets(2).Activate Rows(Cj).Select ActiveSheet.Paste Cj = Cj + 1 End If Ci = Ci + 1 Loop
Application.CutCopyMode = False wb2.Close SaveChanges:=False Application.ScreenUpdating = True End Sub
[/vba]
Возникла трудность в работе макроса, в столбце где происходит поиск значения есть пустые ячейки, и макрос прекращает сразу работу как только натыкается на пустую ячейку, возможно ка кто исправить данный факт или же в файле исходника надо удалять пустые ячейки для корректной работы данного макроса?Xaden
Опять же повторюсь - ну Вы же сами так прописали в коде: цикл идёт пока wb2.Sheets(1).Cells(Ci, 1) не равно "" Если нужно иначе - нужно код писать иначе. Как нужно - известно пока только Вам.
Опять же повторюсь - ну Вы же сами так прописали в коде: цикл идёт пока wb2.Sheets(1).Cells(Ci, 1) не равно "" Если нужно иначе - нужно код писать иначе. Как нужно - известно пока только Вам.Hugo
Простите за назойливость. Добавил файлы. С файла "поставщики" по искомому значению происходит поиск в файле "исходник" в 1 столбце, но если там есть пустые ячейки макрос ничего не находит и в итоге ничего не переносит. Макрос который дали, рабочий, все отлично я его вроде как разобрал, но не понимаю, почему он останавливается, как только доходит до пустой ячейки. Судя по посту выше все достаточно банально и просто, но видать меня не хватает, что бы понять эту банальность.
Простите за назойливость. Добавил файлы. С файла "поставщики" по искомому значению происходит поиск в файле "исходник" в 1 столбце, но если там есть пустые ячейки макрос ничего не находит и в итоге ничего не переносит. Макрос который дали, рабочий, все отлично я его вроде как разобрал, но не понимаю, почему он останавливается, как только доходит до пустой ячейки. Судя по посту выше все достаточно банально и просто, но видать меня не хватает, что бы понять эту банальность.Xaden
Какая ошибка? Где? Когда? Вообще мне тоже фильтр не нравится, я стараюсь делать иначе - обычно копирую данные через массив. Если конечно не нужны форматы и формулы. Мне обычно они не нужны. Что нужно Вам - нам неизвестно.
Какая ошибка? Где? Когда? Вообще мне тоже фильтр не нравится, я стараюсь делать иначе - обычно копирую данные через массив. Если конечно не нужны форматы и формулы. Мне обычно они не нужны. Что нужно Вам - нам неизвестно.Hugo
в том то и дело что мне нужны все форматы и формулы.
Допустим я так пишу[vba]
Код
Do While wb2.Sheets(1).Cells(Ci, 1) <> "="
[/vba], он переносит данные и сразу после переноса макрос выдает ошибку в этой сроке чет я намудрил наверно. Простите я не могу выставить фаил исходник так как он содержит инфо. которую я не могу распространять да и сам фаил весит более 40мб. Поэтому и сделал фаил исходник в качестве примера. Попробую объяснить еще раз. У меня есть фаил "исходник" где содержится информация по всем поставщикам, позициям и всякой ерунде, так вот в файле таких поставщиков очень много, мне например нужно все данные по определенному поставщику перенести в отдельный фаил в целом что и получается сделать, но в столбце поставщиков откуда я произвожу поиск есть пустые ячейки на чем макрос и останавливает свою работу. Если Вас не затруднит и у Вас есть 5-10 мин, скачайте файлы, которые я выше прикрепил, я думаю если вы взгляните на них, вам все станет куда ясней.
в том то и дело что мне нужны все форматы и формулы.
Допустим я так пишу[vba]
Код
Do While wb2.Sheets(1).Cells(Ci, 1) <> "="
[/vba], он переносит данные и сразу после переноса макрос выдает ошибку в этой сроке чет я намудрил наверно. Простите я не могу выставить фаил исходник так как он содержит инфо. которую я не могу распространять да и сам фаил весит более 40мб. Поэтому и сделал фаил исходник в качестве примера. Попробую объяснить еще раз. У меня есть фаил "исходник" где содержится информация по всем поставщикам, позициям и всякой ерунде, так вот в файле таких поставщиков очень много, мне например нужно все данные по определенному поставщику перенести в отдельный фаил в целом что и получается сделать, но в столбце поставщиков откуда я произвожу поиск есть пустые ячейки на чем макрос и останавливает свою работу. Если Вас не затруднит и у Вас есть 5-10 мин, скачайте файлы, которые я выше прикрепил, я думаю если вы взгляните на них, вам все станет куда ясней.Xaden
Сообщение отредактировал Xaden - Пятница, 18.07.2014, 12:13
Do 'работа Loop While wb2.Sheets(1).Cells(Ci, 1) <> "метка"
[/vba]
если в файле есть "метка", которую можно искать. Или использовать цикл For-Next - например перебирать все ячейки usedrange.columns(1), или сперва определить этот диапазон или номера строк от-до, затем их перебрать. хотел Ваш код переделать - но некогда пока что, там почти всё нужно менять...
Можно цикл сделать таким:
[vba]
Код
Do 'работа Loop While wb2.Sheets(1).Cells(Ci, 1) <> "метка"
[/vba]
если в файле есть "метка", которую можно искать. Или использовать цикл For-Next - например перебирать все ячейки usedrange.columns(1), или сперва определить этот диапазон или номера строк от-до, затем их перебрать. хотел Ваш код переделать - но некогда пока что, там почти всё нужно менять...Hugo
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
