поиск и копирование данных между листами в 2 книгах

[staniiislav]

Здравствуйте Ув. форумчане. Столкнулся с проблемой, поиска и копирования данных между двумя книгами по определенным листам. У меня есть пример поиска и копирования данных между двумя книгами и двумя листами. но как сделать грамотно чтобы искало и копировало по нескольким листам, я не могу понять. Прошу помощи. В файлике описал более конкретнее что у меня не получается.
Заранее огромное спасибо!

Забыл сказать, что описание проблемы в книге Основная на первом листе

[Hugo121]

Если есть код копирования между двумя листами разных книг - просто выполняйте его 3 раза, меняя листы.
Можно пройтись циклом по всем листам одной книги, копируя с аналогичного листа другой книги (нужно позаботится, чтоб была пара).
Смотрю, повторов дат быть не должно?
Тогда я бы занёс даты одного листа (в котором ищем) в словарь, в Item словаря позицию этой даты в исходном массиве (ну или сразу данные через разделитель).
Далее циклом по данным, которые ищем, сразу из словаря брал сохранённую позицию, из массива данные (или из Item словаря).
Ну и так столько раз, сколько пар листов - каждый раз новые массивы и словарь.
Но я бы не брал данные "при двух открытых книгах" - лучше кодом открывать вторую книгу, в диалоге или прямо указав путь.

[staniiislav]

Сообщение от Hugo121

Если есть код копирования между двумя листами разных книг - просто выполняйте его 3 раза, меняя листы.
Можно пройтись циклом по всем листам одной книги, копируя с аналогичного листа другой книги (нужно позаботится, чтоб была пара).
Смотрю, повторов дат быть не должно?
Тогда я бы занёс даты одного листа (в котором ищем) в словарь, в Item словаря позицию этой даты в исходном массиве (ну или сразу данные через разделитель).
Далее циклом по данным, которые ищем, сразу из словаря брал сохранённую позицию, из массива данные (или из Item словаря).
Ну и так столько раз, сколько пар листов - каждый раз новые массивы и словарь.
Но я бы не брал данные "при двух открытых книгах" - лучше кодом открывать вторую книгу, в диалоге или прямо указав путь.

Hugo121 посмотрите пример пожалуйста, но пример еще ищет и столбец в который копировать. Как можно сделать по всем листам (в оригинальном файле 33 листа)
Спасибо за ответ!

Смотрю, повторов дат быть не должно? : в книги оригинал даты на год, в книге пт на каждом листе разные дата, и они меняются после достижения 50 дней, через 10 дней еще 50 новых дат. Вот почему нужен макрос, в противном случаи использовал бы ВПР или ИНДЕКС(ПОИСКПОЗ))...

Но я бы не брал данные "при двух открытых книгах" - лучше кодом открывать вторую книгу, в диалоге или прямо указав путь. : стоит проверка на открытие книги, это сделано чтобы не запускался макрос если книга уже открыта, пытался сделать условие если уже открыта то делать так... но через раз работало, так и не понял в чем была проблема...

спасибо, и кстати как убрать в коде проверку на поиск по столбцам?

[Hugo121]

Таймаут, работой завалили... Некогда серьёзно вникать

[staniiislav]

Сообщение от Hugo121

Таймаут, работой завалили... Некогда серъёзно вникать

не вопрос ))) спасибо что откликнулись, будет время, посмотрите пожалуйста.
Спасибо!

[Hugo121]

Попробуйте так - добавил цикл по листам (но если будут другие листы - диаграмм или макросов, то всё рухнет!):

Sub Copyy()
    If bBookOpen("пт.xls") Then
        'If TypeName(Range("A2").Value) = "Empty" Then
        '    MsgBox "Вы не выбрали № корпуса. Сначало выберите № корпуса!"
        '    Range("A2").Activate
        '    Exit Sub
        '    Else
        If MsgBox("Скопировать ?", vbYesNo, "Подтверждение") = vbYes Then
            Dim i%, objSheet(1) As Object, x As Object, sIndex As Byte
            For sIndex = 1 To ThisWorkbook.Sheets.Count
                Set objSheet(0) = Workbooks("пт.xls").Sheets(sIndex)
                Set objSheet(1) = ThisWorkbook.Sheets(sIndex)
                Application.EnableEvents = False    'Не обрабатывать события.
                Application.ScreenUpdating = False    'Отключить перерисовку объектов на экране, чтобы ничего не мигало.
                Application.Calculation = xlCalculationManual    'Выключить расчет. Внимание, если макрос прерваляс посреди работы, то расчет так и останется в ручном режиме!
                With CreateObject("Scripting.Dictionary")
                    objSheet(1).Unprotect ""
                    For Each x In objSheet(0).Columns(1).SpecialCells(xlCellTypeConstants)
                        If x.Value <> "" Then .Add x.Value, x.Address
                    Next
                    i = objSheet(1).UsedRange.Find(objSheet(0).[A1].Value, LookIn:=xlValues).Column
                    For Each x In objSheet(1).Columns(1).SpecialCells(xlCellTypeConstants)
                        If .Exists(x.Value) Then
                            'objSheet(0).Range(.Item(x.Value)).Offset(, 4).Copy objSheet(1).Cells(x.Row, i)
                            objSheet(0).Range(.Item(x.Value)).Offset(, 2).Copy
                            objSheet(1).Cells(x.Row, i).PasteSpecial Paste:=xlPasteValues
                            objSheet(1).Cells(x.Row, i).PasteSpecial Paste:=xlPasteFormats
                        End If
                    Next
                    objSheet(1).Protect ""
                End With
                Application.Calculation = xlCalculationAutomatic    'Выключить расчет. Внимание, если макрос прерваляс посреди работы, то расчет так и останется в ручном режиме!
                Application.ScreenUpdating = True    'Отключить перерисовку объектов на экране, чтобы ничего не мигало.
                Application.EnableEvents = True    'Не обрабатывать события.
                MsgBox "Копирование листов " & sIndex & " завершено."
        Next sIndex
            End If
            'End If
        
    Else


        MsgBox "Книга [пт] закрыта. Для продолжения работы откройте [пт]!", vbInformation, "Сообщение"
    End If

End Sub

'ActiveSheet.DisplayPageBreaks = True ' Отображение границ страниц, тоже почему-то помогает.
'Application.DisplayStatusBar = True 'В статусной строке выводятся различные данные, что замедляет работу, отключаем.
'Application.DisplayAlerts = True 'Это если нужно. Выключает сообщения Экселя. Например, мы делаем Workbook.Close,
'Эксель хочет спросить сохранить ли изменения. При выключении этого параметра все ответы будут даны автоматически (изменения не сохранятся).

P.S. Добавил ThisWorkbook - т.к. у меня после конвертера имя изменилось на непрописываемое

[staniiislav]

Ок, буду что-то придумывать! Спасибо огромное!