Modification to VBA Code - Copying data after drop down list value change and pasting to another sheet

Question

Modification to VBA Code - Copying data after drop down list value change and pasting to another sheet

Alverna 0

Hi. I have this code which I need some assistance modifying - see below.

First modification is the DropDownCell range should include all of column A that contains data not just cell A1. So if you change the value of any cell in column A using the drop down list the code will copy that row and paste in the destination sheet. For example you change the value in cell A7 using the drop down list. The code then copies row 7.
At the moment the code selects the whole of the row to copy and then paste but it only needs to copy from column B to column D and paste that to the destination sheet. Using the example above the code would copy B7:D7 and paste this into the destination sheet.

Any help would be much appreciated. Very beginner here. Thanks.

Private Sub Worksheet_Change(ByVal Target As Range)
  
   Dim SourceSheet As Worksheet, DestSheet As Worksheet
   Dim SourceRange As Range, DestRange As Range
   Dim DropDownCell As Range
   Dim LastRow As Long, i As Long
   Dim CopyRow As Long

   ' Set the sheet and cell references

   Set SourceSheet = ThisWorkbook.Sheets("DataSheet")
   Set DestSheet = ThisWorkbook.Sheets("DestinationSheet")
   Set DropDownCell = Me.Range("A1") ' Change "A1" to the cell containing the dropdown list
  
   ' Check if the changed cell is the dropdown cell
   If Not Intersect(Target, DropDownCell) Is Nothing Then
       ' Find the last row with data in the source sheet
       LastRow = SourceSheet.Cells(Rows.Count, "A").End(xlUp).Row

       ' Find the row to copy based on the dropdown selection
       For i = 2 To LastRow ' Assuming data starts from row 2
           If SourceSheet.Cells(i, 1).Value = DropDownCell.Value Then 
       ' Assuming the dropdown value matches the first column in the     
         data sheet
               CopyRow = i
               Exit For
           End If
       Next i

       ' If a matching row is found, copy the row
       If CopyRow > 0 Then
           ' Set the range to copy from the source sheet
           Set SourceRange = SourceSheet.Rows(CopyRow)
           ' Find the next available row in the destination sheet
           LastRow = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
           ' Set the range to paste to the destination sheet
           Set DestRange = DestSheet.Rows(LastRow)
           ' Copy the row
           SourceRange.Copy
           DestRange.PasteSpecial xlPasteValues
           Application.CutCopyMode = False 'Clear the copy/paste buffer
           ' Optionally, clear the source row after copying
           'SourceRange.ClearContents
       End If
   End If
End Sub

1 answer

Your answer

Answer 1

Barry Schwarz 3,836

You can set DropDownCell to Me.Range("A:A")

Since this will also include cells that don't have values, the test for a valid intersection needs to account for this.

Define a new range.
Set this range to the return from Intersect.
If this range is not Nothing, then verify it has a value
Once the intersection is known to be valid, proceed with finding LastRow and the rest of your code.

Something along the lines of

Dim Sect as Range
...
Set Sect = Intersect(Target, DropDownCell)
If Not Sect Is Nothing Then
    If Sect.Value <> "" Then
        (your code)
    End I
End If

Change the assignment of SourceRange to

Set SourceRange = Range(SourceSheet.Cells(CopyRow,2),SourceSheet.Cells(CopyRow,4))

Alverna 0 Reputation points

2025-07-03T08:46:02.91+00:00

Sadly this has not resolved the problem. But I appreciate the time to provide an answer. Any other suggestions?

Just some more information. With the column with the drop down cell all cells should have something in them unless you reach the end of the data.

When I tried changing the code to Me.Range("A:A") the code seemed to be getting stuck at the line:

If SourceSheet.Cells(i, 1).Value = DropDownCell.Value Then ...
Barry Schwarz 3,836 Reputation points

2025-07-03T18:19:27.03+00:00
If the intersection exists, the result must be the same as Target. You should be using Target.Value in your comparison.

Target and DropDownCell are ranges in the same worksheet which is the active one. Which one is it?

Am I correct in assuming the column A of the active sheet has a contiguous block of cells, each containing a drop down list? If you know the first cell in the block, then you can set DropDownCell as Range(first_cell,first_cell.end(xlDown)).

After finding the row to copy from, you can select columns B:D with

Set SourceRange=Range(SourceSheet.Cells(CopyRow,2),SourceSheet.Cells(CopyRow,4))

You should set DestinationRange to the column in LastRow where you want date from Column B to go, something like DestSheet.Cells(LastRow,2).
Alverna 0 Reputation points

2025-07-06T08:07:10.9466667+00:00

Thanks. I'll have a play with it again this week.
Alverna 0 Reputation points

2025-07-09T20:56:21.9166667+00:00

Thanks for help. I found my problem. The intercept needed to be set to an address not a value. All good now.

Share via

Modification to VBA Code - Copying data after drop down list value change and pasting to another sheet

1 answer

Your answer