Need more efficient code

[Faintkitara]

Hi! I came up with code that filters a set of data and then copies and pastes certain columns(Customer, Project Name, vs) into another worksheet (in columns N, O, and P)

Is there a more efficient way to write this code? Im having to copy/paste the same code three times in one sub.

Someone once told me that if you have to copy and paste something in code, that probably means you can write it better. Thanks for any help

Sub CopyPasteData1()Const Row  As Integer = 4
Const Cust As String = "Customer"
Const Pro As String = "Project Name"
Const vs As String = "vs"
Dim LC  As Integer, J As Integer
Dim lr  As Integer


   LC = Cells(Row, Columns.Count).End(xlToLeft).Column
   For J = LC To 1 Step -1
      If (Cells(Row, J) = Cust) Then
         lr = Cells(Rows.Count, J).End(3).Row
         Range(Cells(Row, J), Cells(lr, J)).Copy
         Worksheets("Backlog").Range(Cells(Row, J), Cells(lr, J)).Copy _
    Destination:=Worksheets("Pivot ").Range("N4:N10000")
      End If
   Next
   
   LC = Cells(Row, Columns.Count).End(xlToLeft).Column
   For J = LC To 1 Step -1
      If (Cells(Row, J) = Pro) Then
         lr = Cells(Rows.Count, J).End(3).Row
         Range(Cells(Row, J), Cells(lr, J)).Copy
         Worksheets("Backlog").Range(Cells(Row, J), Cells(lr, J)).Copy _
    Destination:=Worksheets("Pivot").Range("O4:O10000")
      End If
   Next
   
   LC = Cells(Row, Columns.Count).End(xlToLeft).Column
   For J = LC To 1 Step -1
      If (Cells(Row, J) = vs) Then
         lr = Cells(Rows.Count, J).End(3).Row
         Range(Cells(Row, J), Cells(lr, J)).Copy
         Worksheets("Backlog").Range(Cells(Row, J), Cells(lr, J)).Copy _
    Destination:=Worksheets("Pivot").Range("P4:P10000")
      End If
   Next
   
   On Error Resume Next
Worksheets("Backlog").ShowAllData
On Error GoTo 0


 End Sub

 

[wideboydixon]

Here's my best effort at tidying this up and using meaningful variable names. I coded this blind and I don't have your sheet so please test it first.

Sub CopyPasteData1()

' Constants
Const searchRow As Long = 4
Const customerString As String = "Customer"
Const projectString As String = "Project Name"
Const versusString As String = "vs"

' Variables
Dim lastCol As Long
Dim thisCol As Long
Dim lastRow As Long
Dim targetCell As String

' Sheets
Dim backlogSheet As Worksheet
Dim pivotSheet As Worksheet

' Retrieve the sheets
Set backlogSheet = Worksheets("Backlog")
Set pivotSheet = Worksheets("Pivot")

' Get the last column on the search row (4)
lastCol = backlogSheet.Cells(searchRow, backlogSheet.Columns.Count).End(xlToLeft).Column

' Look through all columns
For thisCol = lastCol To 1 Step -1
    ' No destination
    targetCell = ""
    
    ' See if we are interested in this column
    Select Case backlogSheet.Cells(searchRow, thisCol).Value
        Case customerString
            targetCell = "N4"
        Case projectString
            targetCell = "O4"
        Case versusString
            targetCell = "P4"
    End Select
    
    ' Do we have a target cell?
    If targetCell <> "" Then
        ' Find the last row for this column
        lastRow = backlogSheet.Cells(Rows.Count, thisCol).End(xlUp).Row
        
        ' Copy the data
        backlogSheet.Range(Cells(searchRow, thisCol), Cells(lastRow, thisCol)).Copy Destination:=pivotSheet.Range(targetCell)
    End If
Next thisCol

' Try and show all the data
On Error Resume Next
backlogSheet.ShowAllData
On Error GoTo 0

End Sub

WBD