Excel VBA найти заголовок с определенным значением и скопировать ниже значения

Question

Я пытался сделать следующее и застрял при этом.

Чего я хочу достичь:

1. Поиск определенного текста / значения в диапазоне заголовков различных таблиц (определенный текст / значение из другой таблицы "БД")
2. Когда заголовок с этим значением найден, скопируйте все данные ниже этого заголовка и вставьте его в качестве значения в тот же столбец
3. И, скопируйте формулу в 1 столбец справа от столбца с соответствующим заголовком и вставьте формулу в последнюю строку определенного столбца соответствующего рабочего листа (например, если заголовок со значением найден в H11, скопируйте формулу I12 и вставьте в последнюю строку A в столбце I)
4. Повторите это для всех заголовков в диапазоне различных рабочих листов

Я искал разные источники, чтобы найти код ниже.

Код, который у меня пока есть:

Dim Lr1,lr2,lr3,lr4 As Long
Dim rng, c, rngAddress As Range
Dim period As String

period = Worksheets("DB").Range("Y1")
Lastrow1 = Worksheets("Calc_1").Cells(Rows.Count, "A").End(xlUp).Row
Lastrow2 = Worksheets("Calc_2").Cells(Rows.Count, "A").End(xlUp).Row
Lastrow3 = Worksheets("Calc_3").Cells(Rows.Count, "A").End(xlUp).Row
Lastrow4 = Worksheets("Calc_4").Cells(Rows.Count, "A").End(xlUp).Row

With Worksheets("Calc_1", "Calc_2", "Calc_3", "Calc_4")

    Set rng = Activesheet.Range("G11:Z11")

    For Each c In rng

        If c = period Then

            Range(c, c.End(xlDown)).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
 'cannot figure out the column to the right aspect here

        Else

        End If

    Next

End With

vba не запускается, и мне трудно найти полный код для достижения моей цели. Буду признателен за любую помощь!

Вот что у меня после редактирования:

Dim period As String
Dim ws As Worksheet
Dim rng As Range

period = Worksheets("Model_DB").Range("Y1")
Lastrow1 = Worksheets("Calc_1").Range("A" & .Rows.Count).End(xlUp).Row
Lastrow2 = Worksheets("Calc_2").Range("A" & .Rows.Count).End(xlUp).Row
Lastrow3 = Worksheets("Calc_3").Range("A" & .Rows.Count).End(xlUp).Row

For Each ws In ThisWorkbook.Sheets
    Select Case ws.Name
    Case "Calc_1", "Calc_2", "Calc_3"
        With ws
            For Each rng In .Range("G11:Z11")
                If rng.Value = period Then
                   '/change to value/
                    Range(rng).Select.Copy
                    Range(rng & Lastrow1).Paste Special=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

                    '/put formula on the right column/
                    fn.Offset(1, 1).Copy
                    Range(rng & Lastrow1).Paste Special=xlPasteformulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Exit For
                End If
            Next rng
        End With
    End Select
Next ws

Answer 1

Есть много вещей, которые я бы порекомендовал в вашем коде.

Поиск определенного текста / значения в диапазоне заголовков различных таблиц (определенный текст / значение из другой таблицы «БД») Когда заголовок с этим значением найден, скопируйте все данные ниже этого заголовка и вставьте его как значение в тот же столбец

A. Dim Lr1,lr2,lr3,lr4 As Long

В приведенном выше коде только последняя переменная lr4 будет объявлена ​​как Long, а остальные будут объявлены как Variants. Замените его на Dim Lr1 As Long,lr2 As Long,lr3 As Long,lr4 As Long. Variants замедляет код, так как во время выполнения код должен преобразовывать его в соответствующий тип данных. Их следует избегать, если в этом нет необходимости.

B. With Worksheets("Calc_1", "Calc_2", "Calc_3", "Calc_4") Не делайте этого. Что если заголовок находится в другом столбце? Просмотрите листы и используйте Select Case для работы с соответствующими листами

C. Selection.PasteSpecial Paste:=xlPasteValues..... Вы пытаетесь вставить без копирования? Как я упоминал в комментариях, я не рекомендую использовать xlDown в таком сценарии. Вы правильно вычисляете последнюю строку в начале кода. Используйте это, чтобы определить свой диапазон. Однако то, что вы пытаетесь достичь, можно сделать в одной строке, а не копировать и вставлять специальные.

Ваш код может быть сокращен до ( Не проверено )

Option Explicit

Sub Sample()
    Dim period As String
    Dim ws As Worksheet
    Dim rng As Range

    period = Worksheets("DB").Range("Y1")

    For Each ws In ThisWorkbook.Sheets
        Select Case ws.Name
        Case "Calc_1", "Calc_2", "Calc_3", "Calc_4"
            With ws
                For Each rng In .Range("G11:Z11")
                    If rng.Value = period Then
                        .Columns(rng.Column).Value = .Columns(rng.Column).Value
                        Exit For
                    End If
                Next rng
            End With
        End Select
    Next ws
End Sub

Дайте мне знать, если вы получили какую-либо ошибку в приведенном выше коде.

D. Lastrow1 = Worksheets("Calc_1").Cells(Rows.Count, "A").End(xlUp).Row. Чтобы быть в безопасности, полностью квалифицируйтесь также Rows.Count. Я бы порекомендовал почитать на ЭТО .

Что касается пункта 3 и 4, пожалуйста, покажите некоторые усилия, которые вы предприняли для пункта 1 и 2, и мы возьмем его оттуда. :)