Не удается получить копию, чтобы найти последнюю строку данных

Question

У меня был предыдущий вопрос о том, как найти последнюю строку данных для формулы в столбце A на основе данных в столбце C. И вы помогли мне разобраться в этой части!

Теперь я делаю еще один шаг вперед и просматриваю больше листов. Данные в столбце C правильно копируются / вставляются в следующую доступную строку. Однако формула вставляется поверх первого набора данных в столбце A, а не в последней строке.

Еще лучше ... Есть ли способ сделать эту формулу 1 вкладышем ?? Я тоже не могу заставить это работать.

`Dim Mkts As Worksheet
Dim ws As Worksheet

'Destination Worksheet
    Set Mkts = Workbooks("Nielsen SC Template.xlsm").Worksheets("Markets")

'Copy 4Wk Data
Workbooks.Open "C:\Users\cday\OneDrive - udfinc.com\Nielsen Scorecard\4Wk Data.xlsx"

    Dim Wb4 As Workbook
         Set Wb4 = Workbooks("4Wk Data.xlsx")

For Each ws In Wb4.Worksheets
    With ws
        If .Index <> 1 Then
            
 'Find last used row in the copy range based on data in Column A
    Dim CopyLastRow4 As Long
        CopyLastRow4 = .Cells(.Rows.Count, 1).End(xlUp).Row

 'Find first blank row in the destination range based on data in Column C, Offset 1 Row
    Dim DestLastRowC As Long
        DestLastRowC = Mkts.Cells(Mkts.Rows.Count, "C").End(xlUp).Offset(1).Row

 'Find last used row in the destination range based on data in Column C
    Dim LastRowColumnC As Long
        LastRowColumnC = .Range("C" & .Rows.Count).End(xlUp).Row
    
    If .Index = 2 Then
    'Copy and Paste Data into C3
        .Range("A4:V" & CopyLastRow4).Copy Mkts.Range("C" & DestLastRowC)
    
    'Add Dates to Column A
        Dim FR As Range    'first row
        Dim LR As Range    'last row
            Set FR = Mkts.Range("A3")
            Set LR = Mkts.Range("A" & LastRowColumnC - 1)
                Range(FR, LR).Formula = "=Mid('[4Wk Data.xlsx]Report1'!$A$1, 9, 28)"

    'Add Markets to Column B
        Set FR = Mkts.Range("B3")
        Set LR = Mkts.Range("B" & LastRowColumnC - 1)
            Range(FR, LR).Formula = "=Mid('[4Wk Data.xlsx]Report1'!$A$1, 48, 13)"
    End If
    
    If .Index = 3 Then
        'Copy and Paste Data into C3
        .Range("A4:V" & CopyLastRow4).Copy Mkts.Range("C" & DestLastRowC)
    
    **'Add Dates to Column A
        Set FR = Mkts.Range("A" & DestLastRowC)
        Set LR = Mkts.Range("A" & LastRowColumnC)
            Range(FR, LR).Formula = "=Mid('[4Wk Data.xlsx]Report2'!$A$1, 9, 28)"
    'Add Markets to Column B
        'Set FR = Mkts.Range("B" & DestLastRowC)
        'Set LR = Mkts.Range("B" & LastRowColumnC)
            'Range(FR, LR).Formula = "=Mid('[4Wk Data.xlsx]Report2'!$A$1, 48, 15)"**
    End If

        End If
    End With
Next ws

Answer 1

Попробуйте что-то вроде этого:

Sub Test()
    Dim Mkts As Worksheet, ValA1
    Dim ws As Worksheet, Wb4 As Workbook, rngCopy As Range, rngDest As Range
    
    'Destination Worksheet
    Set Mkts = Workbooks("Nielsen SC Template.xlsm").Worksheets("Markets") 'ThisWorkbook ?

    'Copy 4Wk Data
    Set Wb4 = Workbooks.Open("C:\Users\cday\OneDrive - udfinc.com\Nielsen Scorecard\4Wk Data.xlsx")

    For Each ws In Wb4.Worksheets
        With ws
            If .Index = 2 Or .Index = 3 Then
            
                'range of data to be copied from ws:  A4 to V[last row in colA]
                Set rngCopy = .Range("A4:V" & .Cells(.Rows.Count, 1).End(xlUp).Row)
                'destination for pasting in ColC
                Set rngDest = Mkts.Cells(Mkts.Rows.Count, "C").End(xlUp).Offset(1)
                
                rngCopy.Copy rngDest 'copy the data
                'grab the value from A1 on Report1
                ValA1 = .Range("A1").Value            '<<<<<<
                'fill a range starting from rngDest two columns to the
                '  left and the same size (# of rows) as the copied range
                '  using part of the value from A1  
                rngDest.Offset(0, -2).Resize(rngCopy.Rows.Count).Value = Mid(ValA1, 9, 28)  'ColA
                'similar process for a column one to the left from rngDest  
                rngDest.Offset(0, -1).Resize(rngCopy.Rows.Count).Value = Mid(ValA1, 48, 13) 'ColB
                
            End If
        End With
    Next ws

End Sub