How do we remake the program to copy not one value value but with range in column age

How do we remake the program to copy not one value value but with range in column age? We need copy all values from age.xlsm age column to another age column in shchool.xlsm file

school.xlsm

A B
name age
peter1
jane2
ted
peter3
age.xlsm
A B
name age
mark3 1,2
peter1 5
jane2 1,5
the program copy one value, how do we copy all values from age column from age.xlsm to shool.xlsm file

Sub copydata()
Dim iAge As Integer
Set src = Workbooks.Open("age.xlsm", True, True)
iAge = src.Worksheets("Sheet1").Range("B2").Value
ThisWorkbook.Worksheets("Sheet1").Range("В2").Value = iAge
End Sub
Edit: Code added from comment

Sub Insertdata()
Dim iAge As Integer
Set src = Workbooks.Open("age.xlsm", True, True)
t = 2
lastrow = ActiveSheet.UsedRange.Rows.Count
Do Until t = lastrow
iAge = src.Worksheets("Sheet1").Range("B" & t).Value
ThisWorkbook.Worksheets("Sheet1").Range("B" & t).Value = iAge
t = t + 1
Loop
End Sub
the last makros return wrong output jane2 must be value of 1,5 and it is not it is 5 we need return connected date with key name

new version why program does not work Run-time error '1004' application-defined or object defined error on line If Cells(d, "A") = iName Then

Sub Insertdata()
Dim iAge As Integer
Set src = Workbooks.Open("D:\school1\age.xlsm", True, True)
t = 2
lastrow = ActiveSheet.UsedRange.Rows.Count
Do Until t = lastrow
iAge = src.Worksheets("Sheet1").Range("B" & t).Value
IName = src.Worksheets("Sheet1").Range("A" & t).Value
Do Until d = lastrow
If Cells(d, "A") = IName Then
ThisWorkbook.Worksheets("Sheet1").Range("B" & d).Value = iAge
d = d + 1
End If
Loop

t = t + 1
Loop
End Sub

Quote:

---

Run-time error '1004

---

i guess initial value of d = 0

Option Explicit
Sub Insertdata()
Dim src As Workbook
Dim iAge As Integer
Dim t As Integer
Dim d As Integer
Dim lastrow As Integer
Dim iName As String
Set src = Workbooks.Open("D:\school1\age.xlsm", True, True)
lastrow = ActiveSheet.UsedRange.Rows.Count


MsgBox lastrow
t = 2
d = 2
Do Until t = lastrow
iAge = src.Worksheets("Sheet1").Range("B" & t).Value
iName = src.Worksheets("Sheet1").Range("A" & t).Value
Do Until d = lastrow
If Cells(d, "A") = iName Then
ThisWorkbook.Worksheets("Sheet1").Range("B" & d).Value = iAge

End If
d = d + 1
Loop

t = t + 1
Loop

End Sub

why my program does not work right?The program do not copy all values from age.xlsm age column to another age column in shchool.xlsm file according to name column. Name is key in tables.

this double loop looks terribly inefficient
try like

Code:

---

with src.sheets(sheet1")
  do unitl d = lastrow
    set fnd = range("a:a").find(.cells(d, 1)
    if not fnd is nothing then fnd.offset(,1) = .cells(d, 2)
    d = d + 1
  loop
end with

---

this was typed into the browser so may contain typos or code errors, the code before the loops is still required

i would prefer a second sheet object variable for the initial active sheet, rather than just relying on the activesheet object being the current worksheet /book when the code is running, as when you open the second workbook, the sheet in it may then be the activesheet, so your code both loops look at the same worksheeet, you could test for this ?activesheet.parent.name
maybe
before opening the workbook

Code:

---

set rng = range("a:a")

---

you could even specify the number of rows range("a2:a" & lastrow)
then

Code:

---

with src.sheets(sheet1")
  do unitl d = lastrow
    set fnd = rng.find(.cells(d, 1)
    if not fnd is nothing then fnd.offset(,1) = .cells(d, 2)
    d = d + 1
  loop
end with

---

comiler error syntax error

Option Explicit
Sub Insertdata()
Dim src As Workbook
Dim iAge As Integer
Dim t As Integer
Dim d As Integer
Dim lastrow As Integer
Dim iName As String
Set src = Workbooks.Open("D:\school1\age.xlsm", True, True)
lastrow = ActiveSheet.UsedRange.Rows.Count


with src.sheets(sheet1")
do unitl d = lastrow
set fnd = range("a:a").find(.cells(d, 1)
If Not fnd Is Nothing Then fnd.Offset(, 1) = .Cells(d, 2)
d = d + 1
Loop
End With

End Sub

use code tags when posting code

specify which line contains the error or is highlighted, you still needed an initial value for d
looks like missing a " before sheet1, typo do until, closing bracket after range.find


also i have made some edits to the previous post

too many typos, off to bed

compiler error variable not define on line Set Rng = Range("a:a")

Option Explicit
Sub Insertdata()
Dim src As Workbook
Dim iAge As Integer
Dim t As Integer
Dim d As Integer
Dim lastrow As Integer
Dim iName As String
Set Rng = Range("a:a")
Set src = Workbooks.Open("D:\school1\age.xlsm", True, True)
lastrow = ActiveSheet.UsedRange.Rows.Count
MsgBox lastrow
t = 2


d = 2

With src.Sheets("sheet1")
Do Until d = lastrow
Set fnd = Rng.Find(.Cells(d, 1))
If Not fnd Is Nothing Then fnd.Offset(, 1) = .Cells(d, 2)
d = d + 1
Loop
End With

End Sub

Code:

---

Option Explicit

Sub Insertdata()
    Dim src As Workbook
    Dim iAge As Integer
    Dim t As Integer
    Dim d As Integer
    Dim lastrow As Integer
    Dim iName As String
    Dim Rng As Range

    Set Rng = Range("a:a")
    Set src = Workbooks.Open("D:\school1\age.xlsm", True, True)
    lastrow = ActiveSheet.UsedRange.Rows.Count
   
    MsgBox lastrow
   
    t = 2
    d = 2

    With src.Sheets("sheet1")
        Do Until d = lastrow
            Set fnd = Rng.Find(.Cells(d, 1))
            If Not fnd Is Nothing Then fnd.Offset(, 1) = .Cells(d, 2)
            d = d + 1
        Loop
    End With

End Sub

---

compile error variable not define
Set fnd = Rng.Find(.Cells(d, 1))

do you want to post a workbook (zip first) with some sample data to test against

https://drive.google.com/file/d/1-2g...ew?usp=sharing
file for download

Code:

---

Sub Insertdata()
    Dim src As Workbook
    Dim fnd As Range
    Dim d As Integer
    Dim lastrow As Integer
    Dim Rng As Range

    Set src = Workbooks.Open("c:\temp\dr\age.xlsm", True, True)
'    Set src = Workbooks("age.xlsm")
    Set Rng = src.Sheets("sheet1").Range("a:a")
    d = 1
   
    With ThisWorkbook.Sheets("sheet1")
        lastrow = .UsedRange.Rows.Count
        Do Until d = lastrow
            Set fnd = Rng.Find(.Cells(d, 1))
            If Not fnd Is Nothing Then .Cells(d, 3) = fnd.Offset(, 2)
            d = d + 1
        Loop
    End With
End Sub

---

this is tested to work without error and appears to work as required, but you should test properly