VBA problem

Good afternoon,

i have the code in the attached excel file to copy data from sheet2 to sheet1 when the record numbers are matching: it works only if i run the macro from sheet1, but i would make it run from sheet2 (placing the button), any help?

Another question: it would be possible to modify the code, adding a message error when, copying from sheet2 to sheet1, the destination cells in sheet1 are not empty?

Thank you.

I'd do something like this

Code:

---

Option Explicit


Sub find_and_copy()
    Dim rFrom As Range, rTo As Range, r As Range
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Dim n As Long


    Set wsFrom = Worksheets("From")
    Set wsTo = Worksheets("To")


    Set rFrom = wsFrom.Cells(1, 1).CurrentRegion
    Set rFrom = rFrom.Cells(2, 1).Resize(rFrom.Rows.Count - 1, rFrom.Columns.Count)


    Set rTo = wsTo.Cells(1, 1).CurrentRegion


    For Each r In rFrom.Columns(1).Cells
       
        n = 0
        On Error Resume Next
        n = Application.WorksheetFunction.Match(r.Value, rTo.Columns(1), 0)
        On Error GoTo 0
       
        If n > 0 Then
            If Application.WorksheetFunction.CountA(rTo.Rows(n)) > 1 Then
                MsgBox r.Value & " in row " & n & " already has data"
               
            Else
                r.EntireRow.Copy wsTo.Cells(n, 1)
            End If
        End If
    Next
   
    Application.ScreenUpdating = True
    MsgBox "Finito"
       
End Sub

---

Hi Paul,

thanks for this, but you have inverted the sheets, i would need data from sheet "to" to sheet "from" and i am not sure how to change it.

The one bit that needs changing is an unqualified reference.
Change:
For Each ce In Worksheets("Sheet1").Range("A2:A" & [COUNTA(A:A)])
to:
For Each ce In Worksheets("Sheet1").Range("A2:A" & [COUNTA(Sheet1!A:A)])

Oops, forgot the second part; you can test if the destination cells are empty with:
If rng1.Cells.Count = Application.CountBlank(rng1) Then

In full:

Code:

---

Sub find_and_copy()
Dim ce As Range
Dim f As Range
Dim r As Long
Dim rng1 As Range, rng2 As Range

Application.ScreenUpdating = False
       
For Each ce In Worksheets("Sheet1").Range("A2:A" & [COUNTA(Sheet1!A:A)])
  Set f = Worksheets("Sheet2").Range("A:A").Find(ce, lookat:=xlWhole)
  If Not (f Is Nothing) Then
    r = WorksheetFunction.CountA(f.EntireRow)
    Set rng1 = Worksheets("sheet1").Range(Worksheets("sheet1").Cells(ce.Row, 5), Worksheets("sheet1").Cells(ce.Row, 3 + r))
    If rng1.Cells.Count = Application.CountBlank(rng1) Then
      Set rng2 = Worksheets("sheet2").Range(Worksheets("sheet2").Cells(f.Row, 2), Worksheets("sheet2").Cells(f.Row, r))
      rng1.Value = rng2.Value
    Else
      Application.Goto rng1 'to show the user the destination cells
      Application.ScreenUpdating = True
      MsgBox "destination cells are not empty"
      Application.ScreenUpdating = False
    End If
  End If
Next
Application.ScreenUpdating = True
MsgBox "Finito"
End Sub

---

It works very good, thank you!

Thank you ALL.