Требуется исправление ошибок: автоматическое заполнение нового листа с использованием цикла for

Question

Я пытался часами, и он продолжает показывать сообщение об ошибке.

ОШИБКА ВРЕМЕНИ РАБОТЫ 1004 - Ошибка выбора метода класса диапазона

Может кто-нибудь помочь указать отключение?

Спасибо.

Добавление столбца D к необработанным данным в качестве индекса для поиска

Результат, который я хотел бы получить хотел бы иметь

Sub Macro()
    ActiveSheet.Name = "Data"
    Sheets("Data").Select
    Dim LastRowData As Long
    LastRowData = Range("A" & Rows.Count).End(xlUp).Row
    Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1") = "Lookup"
    Range("D2") = "=RC[-3]&RC[-1]"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D" & Rows.Count)
    Columns("D:D").Copy
    Columns("D:D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Promo"
    Range("A1") = "Date"
    Range("B1") = "SKUs"
    Range("C1") = "Customer"
    Range("D1") = "Regular $"
    Range("E1") = "Promo $"

    Dim iData As Variant
    Dim LastEntry As Variant
    Dim PreviousLast As Variant

    DayofMonth = Sheets("Data").Cells(1, Sheets("Data").Columns.Count).End(xlToLeft).Column - 5
    LastEntry = DayofMonth * (LastRowData - 1)

    For iData = 1 To LastEntry
            Sheets("Data").Select
            Range("F1:AJ1").Select
            Selection.Copy
            PreviousLast = Cells(Rows.Count, "A").End(xlUp).Row

            Sheets("Promo").Range("A2").Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
            Sheets("Promo").Range("B" & PreviousLast + 1 & ":B" & (DayofMonth + PreviousLast + 1)) = Sheets("Data").Range("A" & iData).Value
    Next iData

    Sheets("Promo").Select
    Range("E2") = _
        "=VLOOKUP(RC[-3]&RC[-2], Data!$D:$AJ, MATCH(Promo!RC1, Data!R1, 0)-3, 0)"
    Range("E2").FillDown
        Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Файлы: ссылка на вложение Excel

Answer 1

Огромное спасибо @SJR. Вы мне очень помогли!

Sub Macro()
    ActiveSheet.Name = "Data"
    Dim LastRowData As Long
    LastRowData = Range("A" & Rows.Count).End(xlUp).Row

    Cells.ClearFormats
    Range("A1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With
    Rows("1:1").Font.Bold = True
    Range("D2:I" & LastRowData).NumberFormat = "$#,##0.00"
    Range("E1:AJ1").NumberFormat = "[$-en-US]d-mmm;@"

    With Sheets("Data")
        .Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("D1").Value = "Lookup"
        .Range("D2") = "=RC[-3]&RC[-1]"
        .Range("D2").AutoFill Destination:=.Range("D2:D" & LastRowData)
        .Range("D2:D" & LastRowData).Copy
        .Range("D2:D" & LastRowData).PasteSpecial xlPasteValues
    End With

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Promo"
    With Sheets("Promo")
        .Range("A1").Value = "Date"
        .Range("B1").Value = "Style"
        .Range("C1").Value = "Customer"
        .Range("D1").Value = "Regular $"
        .Range("E1").Value = "Promo $"
        .Range("1:1").Font.Bold = True
    End With

    Dim iData As Variant
    Dim LastEntry As Variant
    Dim PreviousLast As Variant

    DayofMonth = Sheets("Data").Cells(1, Sheets("Data").Columns.Count).End(xlToLeft).Column - 5
    LastEntry = DayofMonth * LastRowData - 5 + 1

    For iData = 1 To LastRowData - 1
        PreviousLast = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Sheets("Data").Range("F1:AJ1").Copy
        Sheets("Promo").Range("A" & PreviousLast).PasteSpecial Transpose:=True
        Sheets("Data").Range("A" & iData + 1).Copy
        Sheets("Promo").Range("B" & PreviousLast & ":B" & (DayofMonth + PreviousLast - 1)).PasteSpecial
        Sheets("Data").Range("C" & iData + 1).Copy
        Sheets("Promo").Range("C" & PreviousLast & ":C" & (DayofMonth + PreviousLast - 1)).PasteSpecial
        Sheets("Data").Range("E" & iData + 1).Copy
        Sheets("Promo").Range("D" & PreviousLast & ":D" & (DayofMonth + PreviousLast - 1)).PasteSpecial
    Next iData

    With Sheets("Promo")
        .Range("E2").NumberFormat = "$#,##0.00"
        .Range("E2").FormulaR1C1 = _
            "=VLOOKUP(RC2&RC3, Data!C4:C36, MATCH(Promo!RC1,Data!R1, 0) - 3,0)"
        .Range("E2").AutoFill Destination:=.Range("E2:E" & LastEntry)
        .Range("E2:E" & LastEntry).Copy
        .Range("E2:E" & LastEntry).PasteSpecial Paste:=xlPasteValues
    End With

    Range("A1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With

    Rows("1:" & LastEntry).Select
    Selection.AutoFilter Field:=5, Criteria1:="=$0.00"
    Selection.Offset(1, 0).EntireRow.Delete
    ActiveSheet.ShowAllData
End Sub