".EntireRow.Copy Destination:=" to specific range

[ToseSenpai]

Hi,

I have this VBA code that i can use for search a specific value (for example "R") in a sheet and then copy the row with the specific value in an other sheet.
How can i copy only a specific range instead the entire row?
".EntireRow.Copy Destination:=destRng"
I need to copy only A-B-C-D-F the specific row, not entire row.

Thank you very much for your help

Public Sub SMACROTRRRR()

    Dim WB As Workbook
    Dim srcSH As Worksheet, destSH As Worksheet
    Dim srcRng As Range, destRng As Range
    Dim rCell As Range
    Dim delRng As Range
    Dim iLastRow As Long, jLastRow As Long

    Const sStr As String = "R"                                                                    '<<==== Edit


    Set WB = ThisWorkbook

    With WB
    Set srcSH = .Sheets("MEMO")                                                             '<<==== Edit
    Set destSH = .Sheets("ARCHIVIO RETTIFICHE")                                                           '<<==== Edit
    End With

    With srcSH
        iLastRow = LastRow(srcSH, .Columns("A:A"))
        Set srcRng = .Range("A1:A" & iLastRow)
    End With

    With destSH
        jLastRow = LastRow(destSH, .Columns("A:A"))
        Set destRng = .Range("A" & jLastRow + 1)
    End With

    On Error GoTo XIT
    Application.ScreenUpdating = False
    For Each rCell In srcRng.Columns(24).Cells
        With rCell
            If UCase(.Value) = UCase(sStr) Then
                If delRng Is Nothing Then
                    Set delRng = rCell
                Else
                    Set delRng = Union(rCell, delRng)
                End If
            End If
        End With
    Next rCell

    If Not delRng Is Nothing Then
        With delRng
       
            .EntireRow.Copy Destination:=destRng
        End With
    Else
        'nothing found, do nothing
    End If

End Sub

 

[My Aswer Is This]

Try this:
I assume you want to copy columns A To F

Sub Copy_Partial_Row()
'Modified  4/18/2021  8:00:11 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Sheets("MEMO").Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
Lastrowa = Sheets("ARCHIVIO RETTIFICHE").Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To Lastrow
    If Cells(i, 1).Value = "R" Then
        Cells(i, 1).Resize(, 6).Copy Sheets("ARCHIVIO RETTIFICHE").Cells(Lastrowa, 1)
        Lastrowa = Lastrowa + 1
    End If
Next
Application.ScreenUpdating = True
End Sub

 

[ToseSenpai]

Try this:
I assume you want to copy columns A To F

Sub Copy_Partial_Row()
'Modified  4/18/2021  8:00:11 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Sheets("MEMO").Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
Lastrowa = Sheets("ARCHIVIO RETTIFICHE").Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To Lastrow
    If Cells(i, 1).Value = "R" Then
        Cells(i, 1).Resize(, 6).Copy Sheets("ARCHIVIO RETTIFICHE").Cells(Lastrowa, 1)
        Lastrowa = Lastrowa + 1
    End If
Next
Application.ScreenUpdating = True
End Sub

Ty for the reply.
I got a problem with Lastrowa + 1.
The macro copy the columns correctly but when he paste in the sheet ("ARCHIVIO RETTIFICHE") it overwrites the first row full always.
You know why?
Thank you very much!

 

[My Aswer Is This]

Try this:
This assumes you do have some data in Range("A1") of sheet named "ARCHIVIO RETTIFICHE"

Sub Copy_Partial_Row()
'Modified  4/18/2021  8:56:40 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Sheets("MEMO").Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
Lastrowa = Sheets("ARCHIVIO RETTIFICHE").Cells(Rows.Count, "A").End(xlUp).Row + 1

For i = 1 To Lastrow
    If Cells(i, 1).Value = "R" Then
        Cells(i, 1).Resize(, 6).Copy Sheets("ARCHIVIO RETTIFICHE").Cells(Lastrowa, 1)
        Lastrowa = Lastrowa + 1
    End If
Next
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Or use this:
This is a filter script which may be faster:

Sub Filter_Me_Please()
'Modified  4/18/2021  10:07:54 AM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Dim lastrowa As Long
Dim c As Long
Dim s As Variant
c = 1 ' Column Number Modify this to your need
s = "R" 'Search Value Modify to your need
lastrow = Sheets("MEMO").Cells(Rows.Count, c).End(xlUp).Row
lastrowa = Sheets("ARCHIVIO RETTIFICHE").Cells(Rows.Count, c).End(xlUp).Row + 1

With Sheets("MEMO").Cells(1, c).Resize(lastrow, 6)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Sheets("ARCHIVIO RETTIFICHE").Cells(lastrowa, 1)
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

 

[Fluff]

@ToseSenpai
Which column contains the R is it column A or column X?

 

[Marc L]

Hi !​

I have this VBA code that i can use for search a specific value (for example "R") in a sheet and then copy the row with the specific value in an other sheet.

If you can't post an attachment then well elaborate your need at least ! Which sheets, which column to search for a value, …​

 

[My Aswer Is This]

@ToseSenpai
Which column contains the R is it column A or column X?

In post 3 the user already said this:
I got a problem with Lastrowa + 1.
The macro copy the columns correctly but when he paste in the sheet ("ARCHIVIO RETTIFICHE") it overwrites the first row full always.
So my script works just needed a minor change.

 

[Fluff]

That's why I asked the question as the OP's code is looking at col X, not col A

 

[My Aswer Is This]

That's why I asked the question as the OP's code is looking at col X, not col A

Well I see this:
With srcSH
iLastRow = LastRow(srcSH, .Columns("A:A"))
Set srcRng = .Range("A1:A" & iLastRow)
End With