'Paste copied values in row where date was found

I have column A with dates. I have data in range o4:z4 that is manipulated by pivot with Timeline.

I need to paste that data from o4:z4 to column B2:M2. The row number is indicated as example.

I need to paste that data to the row where is yesterday's date Example 12/27/2021.



Solution 1:[1]

An alternative without using evaluate

Option Explicit

Sub Datos_nustatymas()

    Dim wb As Workbook, ws As Worksheet
    Dim LastRow As Long, i As Long, r As Long
    Dim dt As Date, dtLast As Date, newdays As Long
    
    Set wb = ThisWorkbook
    wb.RefreshAll ' Refresh Pivot '
    
    Application.ScreenUpdating = False
    Set ws = wb.Sheets("Report")
    With ws
    
        ' find end of existing data in B
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        
        ' calc number of days to yesterday
        dtLast = .Range("A" & LastRow).Value2
        newdays = Date - 1 - dtLast
        
        If newdays < 1 Then
            MsgBox "No days to add", vbExclamation
            Exit Sub
        Else
            ' extend column A to yesterday
            With .Range("A" & LastRow + 1).Resize(newdays)
                .Formula = "=R[-1]C+1"
                .Value = .Value
            End With
        End If
        
        'update column B
        For i = 1 To newdays
            r = LastRow + i
            dt = .Cells(r, "A")
            
             ' this code selects a timeline date
            .SlicerCaches("NativeTimeline_Value_Date").TimelineState. _
                SetFilterDateRange dt, dt
            .SlicerCaches("NativeTimeline_Good_Date").TimelineState. _
                 SetFilterDateRange dt, dt
        
            ' Copy/Paste details from Pivot to celected cells'
            .Range("O4:Z4").Copy
            .Cells(r, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
        Next
    End With
    Application.ScreenUpdating = True

    MsgBox newdays & " days added", vbInformation
        
End Sub

Solution 2:[2]

Thanks for the help @CDP1802

Got the answer in another thread


Sub Datos_nustatymas()

Dim lastrow_blank As Long
Dim lastrow_blankA As Long
Dim lastrow_blankselection As Long
Dim a As Long

Sheets("Report").Select ' Select sheet '

ThisWorkbook.RefreshAll ' Refresh Pivot '

Data = Date - 1 ' Yesterdays date '

lastrow_blankA = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1 ' first blank cell in column A '
lastrow_blank = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1 ' first blank cell in column B '

a = Range("A2").Value
Range("A3:A" & CLng(Date - a + 1)).Value = Evaluate("Row(" & a + 1 & ":" & CLng(Date) & ")") ' Paste date's until yesterday in column A '

Do Until IsEmpty(Cells(lastrow_blank, 1))

lastrow_blankselection = CDate(Cells(lastrow_blank, 1).Value) ' Value selection of the last low in column A '

If Cells(lastrow_blank, 1) = "" Then ' If first cell in column B is empty then '
MsgBox "Info" ' Message if cell is empty '
Exit Sub
    Else
ActiveWorkbook.SlicerCaches("NativeTimeline_Value_Date").TimelineState. _
        SetFilterDateRange lastrow_blankselection, lastrow_blankselection           ' this code selects a timeline date '
    ActiveWorkbook.SlicerCaches("NativeTimeline_Good_Date").TimelineState. _
        SetFilterDateRange lastrow_blankselection, lastrow_blankselection           ' this code selects a timeline date '
        
Sheets("Report").Range("O4:Z4").Copy ' Copy cells that returns details from Pivot '

Cells(lastrow_blank, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False ' Paste details from Pivot to celected cells'
        
        ' when the code is launched it loops first time correctly and then after the paste code it gets stuck i think because it does nothing'
        ' After I cancel the code paste code get highlited in yellow '
          End If
        lastrow_blank = lastrow_blank + 1
       Loop
End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 CDP1802
Solution 2 Mindaugas Vilimas