Умный перенос данных по ячейкам в ячейки другого листа

[Toffifee]

Да дело не в именах!
Код, который Вы предложили, тот что берет из папки список городов и подставляет с первого листа значения в 47 лист, этот код я запускаю в той книге, которая НЕ содердит в первом листе "Бюджет". И я не могу скопировать туда этот лист из другой книги, потому что эжто специальный отчет, его нельзя менять, можно только окпировать из него.

К нас изначально как было, вот: http://www.programmersforum.ru/showthread.php?t=151417
Т.е. мы взяли 2 книги. Первая - это книга здоровая, мы из неё 3 листа дергали, а вторая поменьше, мы оттуда ещё один лист дергали. И получалась у нас новая книга, с 4-мя листами.

А в этой теме мы работали с книгой "ежедневный отчет", с теми 4-мя листами. И там мы из 1-го листа копировали значения по ячейкам во второй. То есть с листа "Бюджет" на лист "1С И ПРОЧЕЕ".

И код работает именно так. Но я не могу код, который Вы представили вставить в книгу "Ежедневный отчет", потому что эта книга формируется каждый раз новая. В неё макрос не вставишь.

поэтому я подумала, что можно было бы запускать такой макрос, который всё делал бы сразу, запускать из той огромной книги, с которой мы 4 листа дергаем.
То есть запустили, макрос скопировал нужные нам 4 листа в новую книгу "Ежедневный отчет", а за ним следом пошел макрос Sub Perenos(), который скопировал значения.
Либо скопировать сначала значения, а потом уже переносить листы. Но 'для этого придется обращаться к открытому файлу, где находится лист "Бюджет".

Надеюсь я понятно объяснила ))))) жесть какая то.....

[Hugo121]

Всё можно сделать. Макросам бо большому счёту безразлично, в какой книге они находятся - нужно просто их правильно написать. Дать в коде ссылки на нужные книги, и работать с этими ссылками.
Но я сейчас в общем не могу задачу понять - Вы хотите сперва скопировать листы, а потом в один из них переносить данные из другой книги? Может быть сперва перенести данные, а затем копировать, как я выше написал?

Ну если копировать в новую - тогда так попробуйте.
Изменения минимальны - wb теперь доступна из второго макроса, в неё и копируем/переносим данные.
Запускать только Sub Создать_Ежедневный_Отчет() - из него будет вызов второго макроса.

Option Explicit

Dim wb As Workbook ' эта книга будет доступна из любого макроа модуля

Sub Создать_Ежедневный_Отчет()
'
' Создать_Ежедневный_Отчет Макрос
'
Dim nsheet As Worksheet

Sheets(Array("КАССА ИТОГ", "1С И ПРОЧЕЕ", "АНАЛИЗ ПРИБЫЛИ")).Copy
Set wb = ActiveWorkbook ' ссылка на новую созданную книгу

Dim itogWB As Workbook
For Each itogWB In Workbooks
If InStr(itogWB.Name, "Итог") Then
itogWB.Sheets("Бюджет").Copy Before:=wb.Worksheets(1)
With wb.Worksheets(1)
    .Columns("C:AH").EntireColumn.Hidden = True
    .Columns("AP:AY").EntireColumn.Hidden = True
End With
Exit For
End If
Next

Perenos 'вызываем второй макрос

wb.SaveAs Filename:="C:\Ежедневный отчет.xlsx", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub

Sub Perenos()
Dim a(), oDict As Object, i&, x As Range, iFirstAddress$, ii&
Application.ScreenUpdating = False

With GetObject("C:\temp\Toffifee\2\Spisok_gorodov.xls")
    With .Sheets(1)
        a = .Range("A1:B" & .Range("B" & .Rows.Count).End(xlUp).Row).Value
    End With
.Close 0
End With

    Set oDict = CreateObject("Scripting.Dictionary")
    oDict.CompareMode = vbTextCompare

    For i = 1 To UBound(a): oDict.Item(a(i, 1)) = a(i, 2): Next

With [Лист1]
    a = .Range("B6:AM" & .Range("AM" & .Rows.Count).End(xlUp).Row - 1).Value ' диапазон столбцов с цифрами во вкладке "Бюджет"
End With


With wb.[Лист47] ' переход на лист "1С и прочее" в новой книге
For i = 1 To UBound(a)
If oDict.Exists(a(i, 1)) Then
Set x = .Rows(7).Find(oDict.Item(a(i, 1)), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

If Not x Is Nothing Then 'если нашли

    iFirstAddress = x.Address 'запоминаем адрес
            
    Do 'цикл
        Set x = .Rows(7).FindNext(x) 'ищем дальше
        If x.Offset(1, 0) = "ЦМ" Then
'        'тут делаем дело с найденным, копируем значения
'        'из массива на лист в найденные столбцы
       For ii = 13 To 17: .Cells(ii, x.Column).Value = a(i, ii + 21): Next
       Exit Do 'выход, т.к. уже нашли, что искали
'        Debug.Print x.Address ' для проверки
        End If
    'ищем дальше, пока не вернёмся к первому найденному
    Loop While Not x Is Nothing And x.Address <> iFirstAddress
    
End If

End If
Next
End With

Erase a 'освобождаем память
Application.ScreenUpdating = True
End Sub

[Toffifee]

Ну наверное лучше сформировать из 2-х книг как мы делали, Едежневный отчет. А потом уже обратиться к этой книге, и там из первого листа "Бюджет", скопировать значения во второй лист "1С И ПРОЧЕЕ". Вот... И всё это запускать с первой огромной книги.

[Hugo121]

Ага... Тогда исправьте:
With wb.[Лист1]
Вроде так должно получиться.

[Toffifee]

With wb.[Лист47] ' переход на лист "1С и прочее" в новой книге
For i = 1 To UBound(a)
If oDict.Exists(a(i, 1)) Then
Set x = .Rows(7).Find(oDict.Item(a(i, 1)), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

вот на этой строчке он выводит ошибку.

Я сменила на With wb.[Лист2], всё равно ошибка

[Hugo121]

Хорошо, поменяйте кодовое имя на имя листа, т.е.
With wb.Sheets("name")
Какое именно имя нужно - лучше Вы сами впишите, я запутался.

[Toffifee]

Я сама уже путаться начала ))))))
Вот аткой код есть у меня сейчас. Ошибку всё равно выдает...


Option Explicit

Dim wb As Workbook ' эта книга будет доступна из любого макроа модуля

Sub Создать_Ежедневный_Отчет()
'
' Создать_Ежедневный_Отчет Макрос
'
Dim nsheet As Worksheet

Sheets(Array("КАССА ИТОГ", "1С И ПРОЧЕЕ", "АНАЛИЗ ПРИБЫЛИ")).Copy
Set wb = ActiveWorkbook ' ссылка на новую созданную книгу

Dim itogWB As Workbook
For Each itogWB In Workbooks
If InStr(itogWB.Name, "С") Then
itogWB.Sheets("Бюджет").Copy Before:=wb.Worksheets(1)
With wb.Worksheets(1)
.Columns("C:AH").EntireColumn.Hidde n = True
.Columns("AP:AY").EntireColumn.Hidd en = True
End With
Exit For
End If
Next

Perenos 'вызываем второй макрос

wb.SaveAs Filename:="C:\Temp\Ежедневный отчет.xlsx", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub

Sub Perenos()
Dim a(), oDict As Object, i&, x As Range, iFirstAddress$, ii&
Application.ScreenUpdating = False

With GetObject("C:\temp\Spisok_gorodov.x ls")
With .Sheets(1)
a = .Range("A1:B" & .Range("B" & .Rows.Count).End(xlUp).Row).Value
End With
.Close 0
End With

Set oDict = CreateObject("Scripting.Dictionary" )
oDict.CompareMode = vbTextCompare

For i = 1 To UBound(a): oDict.Item(a(i, 1)) = a(i, 2): Next

With [Лист1]
a = .Range("B6:AM" & .Range("AM" & .Rows.Count).End(xlUp).Row - 1).Value ' диапазон столбцов с цифрами во вкладке "Бюджет"
End With

With wb.Sheets("1C И ПРОЧЕЕ") ' переход на лист "1С и прочее" в новой книге
For i = 1 To UBound(a)
If oDict.Exists(a(i, 1)) Then
Set x = .Rows(7).Find(oDict.Item(a(i, 1)), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

If Not x Is Nothing Then 'если нашли

iFirstAddress = x.Address 'запоминаем адрес

Do 'цикл
Set x = .Rows(7).FindNext(x) 'ищем дальше
If x.Offset(1, 0) = "ЦМ" Then
' 'тут делаем дело с найденным, копируем значения
' 'из массива на лист в найденные столбцы
For ii = 13 To 17: .Cells(ii, x.Column).Value = a(i, ii + 21): Next
Exit Do 'выход, т.к. уже нашли, что искали
' Debug.Print x.Address ' для проверки
End If
'ищем дальше, пока не вернёмся к первому найденному
Loop While Not x Is Nothing And x.Address <> iFirstAddress

End If

End If
Next
End With

Erase a 'освобождаем память
Application.ScreenUpdating = True
End Sub

[Hugo121]

Так, вот тут ещё поправьте - из какого листа данные берёте:

With [Лист1]
a = .Range("B6:AM" & .Range("AM" & .Rows.Count).End(xlUp).Row - 1).Value ' диапазон столбцов с цифрами во вкладке "Бюджет"
End With

Вероятно нужно
With wb.Sheets("Бюджет")

[Toffifee]

Всё исправила, всё равно вот такая ошибка:
ошибка.JPG

вот на этом месте:
With wb.Sheets("Бюджет")
a = .Range("B6:AM" & .Range("AM" & .Rows.Count).End(xlUp).Row - 1).Value ' диапазон столбцов с цифрами во вкладке "Бюджет"
End With

[Hugo121]

Или значение wb неизвестно, или нет такого листа.
Посмотрите в редакторе в этом месте, что в переменной wb.