Where in my code can i insert or modify the paste as value snipped?, is pasting formulas.

[AndyJR]

Hi,

Sorry to bother vba experts.

I have a code that it grabs values that match in a range in sheet1 and the matched cells copy on sheet2.
But it pasting the formulas instead,, I need to paste as values.
The problem is that i can't identify where to insert the paste snipped
I'm sorry but for me the code is not readable (conventional, you know as... PasteSpecial xlPasteValues )


I just need to someone tell me "replace this line" by "this one", then I'll read, study about it.

Thank you in advance!

This is the code:

Public Sub kopyPaste_A()
    Dim RefRg As Range, R As Range
    Dim WkRg As Range, W As Range
    Dim HRg  As Range
    Dim DataRg As Range
    Const WS1Name As String = "FL536A"
    Const WS2Name As String = "ANA" '*        change the sheet name to you needs

    Set RefRg = Sheets(WS1Name).Range("I12:M12")
    Set HRg = Sheets(WS1Name).Range("D2:BQ2")
    Set WkRg = Sheets(WS1Name).Range("D3:E12")
    
    Dim xRow        As Long '*  keep track of the row being added
    Dim HeadRow     As Long '*  the header row in the target sheet, based on the cell = "DATE" in column A
    HeadRow = 4
    Worksheets(WS2Name).Activate
    Worksheets(WS2Name).Rows(HeadRow + 1 & ":" & HeadRow + RefRg.Columns.Count).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    
    For Each R In RefRg
        For Each W In WkRg
            If (R = W.Offset(, 1)) Then
                xRow = xRow + 1
                W.Resize(1, HRg.Count).Copy Destination:=Worksheets(WS2Name).Cells(HeadRow + xRow, "A").End(3)(2).Value   '<- I modified this line but no success
                Exit For
            End If
        Next W
    Next R
    Application.CutCopyMode = False
    Set HRg = Worksheets(WS2Name).Range("A3").CurrentRegion
    Worksheets(WS2Name).Sort.SortFields.Clear
    Worksheets(WS2Name).Sort.SortFields.Add Key:=Range("A" & HeadRow & ":A" & HRg.Rows.Count), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    Worksheets(WS2Name).Sort.SortFields.Add Key:=Range("B" & HeadRow & ":B" & HRg.Rows.Count), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets(WS2Name).Sort
        .SetRange HRg
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A" & HeadRow).End(xlDown).Offset(1, 0).Select
    MsgBox ("Job Done")
End Sub

 

[Fluff]

Try

W.Resize(1, HRg.Count).Copy
Worksheets(WS2Name).Cells(HeadRow + xRow, "A").End(3)(2).PasteSpecial xlPasteValues

 

[Tom.Jones]

Try:

Worksheets(WS2Name).Cells(HeadRow + xRow, "A").End(3)(2).Value =W.Resize(1, HRg.Count).value

or

W.Resize(1, HRg.Count).Copy
Worksheets(WS2Name).Cells(HeadRow + xRow, "A").End(3)(2).PasteSpecial xlPasteValues

 

[AndyJR]

Mr Fluff and Mr Tom.Jones


Thank you !!

 

[Fluff]

You're welcome & thanks for the feedback

 

[AndyJR]

Hi,

I'm sorry again but the code stop and it highlight a line with yellow color on :

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow

I know is an error but why?

Thanks

 

[AndyJR]

Hi Excel Family,


I think i found the error, (Hope so), made some changes

So this is the code without error (please if interested, check the Code from Post #1 vs This one (post #7, This one)

Thanks!!!

Public Sub kopyPaste_A()
    Dim RefRg As Range, R As Range
    Dim WkRg As Range, W As Range
    Dim HRg  As Range
    Dim DataRg As Range
    Const WS1Name As String = "FL536A"
    Const WS2Name As String = "ANA" '*        change the sheet name to you needs

    Set RefRg = Sheets(WS1Name).Range("I12:M12")
    Set HRg = Sheets(WS1Name).Range("D2:N2")
    Set WkRg = Sheets(WS1Name).Range("D3:E12")
    
    Dim xRow        As Long '*  keep track of the row being added
    Dim HeadRow     As Long '*  the header row in the target sheet, based on the cell = "DATE" in column A
    HeadRow = 1 ' CAMBIE ESTE
    Worksheets(WS2Name).Activate
    Worksheets(WS2Name).Rows(HeadRow + 1 & ":" & HeadRow + RefRg.Columns.Count).Select
    'Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    
    For Each R In RefRg
        For Each W In WkRg
            If (R = W.Offset(, 1)) Then
                xRow = xRow + 1
                W.Resize(1, HRg.Count).Copy
                Worksheets(WS2Name).Cells(HeadRow + xRow, "A").End(3)(2).PasteSpecial xlPasteValues
                Exit For
            End If
        Next W
    Next R
    Application.CutCopyMode = False
    Set HRg = Worksheets(WS2Name).Range("A2").CurrentRegion
    Worksheets(WS2Name).Sort.SortFields.Clear
    Worksheets(WS2Name).Sort.SortFields.Add Key:=Range("A" & HeadRow & ":A" & HRg.Rows.Count), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    Worksheets(WS2Name).Sort.SortFields.Add Key:=Range("A" & HeadRow & ":A" & HRg.Rows.Count), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets(WS2Name).Sort
        .SetRange HRg
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A" & HeadRow).End(xlDown).Offset(1, 0).Select
    MsgBox ("Job Done")
End Sub