Доброго времени суток. Подскажите пожалуйста как можно оптимизировать макрос? Изучаю vba недавно и не знаю всех тонкостей. Сейчас макрос работает корректно и все обновляет, но если добавить листы то происходит ошибка. Как я понял нужно убрать цикличность и как то указать лист источник и лист куда вставляем (с чем сравниваем)
Код
Sub CopyData()
Dim wbkX As Workbook 'книга
Dim shtSv As Worksheet, shtX As Worksheet 'листы
Dim rngSv As Range, rngX As Range 'диапазоны
Dim NrowSv As Long, NrowX As Long 'число строк
Dim NcolSv As Integer, NcolX As Integer 'число столбцов
Dim TitleSv, TitleX '"будущие" массивы заголовков
Dim i As Long, j As Long 'счетчики циклов
Dim rngCopy As Range, rngPaste As Range 'что копировать и куда вставить
Set wbkX = ThisWorkbook
'= 1 == для листа "лист1" ======================
Set shtSv = wbkX.Worksheets("Лист1")
Set rngSv = shtSv.Range("A1").CurrentRegion
NrowSv = rngSv.Rows.Count
NcolSv = rngSv.Columns.Count
TitleSv = rngSv.Rows(1)
'= 2 == Цикл по всем листам, кроме "Лист1" ======================
For Each shtX In wbkX.Worksheets
Select Case shtX.Name
Case "Лист1" 'для листа "реестр" - ничего не делаем!
Case Else '-- 3 -- для прочих листов ---------
Set rngX = shtX.Range("A1").CurrentRegion
NrowX = rngX.Rows.Count
NcolX = rngX.Columns.Count
TitleX = rngX.Rows(1)
'-- 4 -- поиск совпадающих заголовков ---------
For i = 1 To NcolSv
For j = 1 To NcolX
'-- 5 -- если заголовки совпали, то ...
If TitleSv(1, i) = TitleX(1, j) Then
'- 6 - что копировать ----
Set rngCopy = Range(rngX.Cells(2, j), rngX.Cells(NrowX, j))
'- 7 - куда вставить ----
Set rngPaste = rngSv.Cells(1 + 1, i).Resize(NrowX - 1, 1)
'- 8 - копирование через буфер обмена -----
rngCopy.Copy
rngPaste.PasteSpecial
End If
Next j
Next i
'-- 9 -- определить новые размеры диапазона на листе "Лист1" ---
Set rngSv = shtSv.Range("A1").CurrentRegion
NrowSv = rngSv.Rows.Count
End Select
Next shtX '== конец цикла по листам ========================================
End Sub
PMO87, вы бы лучше описали что делает Ваш макрос с файлом примером где исходные данные и рядом или на другом листе желаемый результат. С файлом проще помогать
Доброго. С листа читая макрос не вижу почему добавка листов может вызывать ошибку (кстати, какую, как выглядит ошибка?) Вот эти инструкции:
Код
rngCopy.Copy
rngPaste.PasteSpecial
Зачем PasteSpecial? Вы хотите вставить что-то конкретное (значение, формат, формулу)? Тогда почему после PasteSpecial не указано что именно хотите вставить? Если просто вставить, то достаточно
Код
rngCopy.Copy rngPaste
Поддерживаю вышесказанное - с файлом-примером было бы легче понимать задачу.
Загрузил файл при + скрин ошибки если запускаешь макрос с новыми листами.
Смысл такой что есть - таблицы источник (множество столбцов) и таблица Получатель куда копируются данные с N столбцами. Задачи автоматически обновлять данные в таблицу Получатель из таблицы Источник по столбцам шапки не зависимо в каком месте они находятся на листе.
Т.е. сейчас ошибка при добавлении листа и если шапка таблицы Источник находится не на первой строке