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

1. ## 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 Reply With Quote

2. ## Re: How do we remake the program to copy not one value value but with range in column

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 Reply With Quote

3. ## Re: How do we remake the program to copy not one value value but with range in column

Run-time error '1004
i guess initial value of d = 0 Reply With Quote

4. ## Re: How do we remake the program to copy not one value value but with range in column

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 Reply With Quote

5. ## Re: How do we remake the program to copy not one value value but with range in column

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. Reply With Quote

6. ## Re: How do we remake the program to copy not one value value but with range in column

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``` Reply With Quote

7. ## Re: How do we remake the program to copy not one value value but with range in column

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 Reply With Quote

8. ## Re: How do we remake the program to copy not one value value but with range in column

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 Reply With Quote

9. ## Re: How do we remake the program to copy not one value value but with range in column

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 Reply With Quote

10. ## Re: How do we remake the program to copy not one value value but with range in column

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``` Reply With Quote

11. ## Re: How do we remake the program to copy not one value value but with range in column

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

12. ## Re: How do we remake the program to copy not one value value but with range in column

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

13. ## Re: How do we remake the program to copy not one value value but with range in column Reply With Quote

14. ## Re: How do we remake the program to copy not one value value but with range in column

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 Reply With Quote

#### Tags for this Thread

excel, visual basic #### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•

Click Here to Expand Forum to Full Width
{"ft_lang_label":"__label__en","ft_lang_prob":0.7850576,"math_prob":0.9192217,"size":10429,"snap":"2021-21-2021-25","text_gpt3_token_len":3041,"char_repetition_ratio":0.12019185,"word_repetition_ratio":0.6097303,"special_character_ratio":0.27193403,"punctuation_ratio":0.121292606,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.99041975,"pos_list":[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60],"im_url_duplicate_count":[null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2021-06-19T18:32:20Z\",\"WARC-Record-ID\":\"<urn:uuid:69e7b31c-4b7d-41d7-bb7a-cd2990906bb1>\",\"Content-Length\":\"153339\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:56f8037a-68f2-4348-909b-43526b25f605>\",\"WARC-Concurrent-To\":\"<urn:uuid:f0e432e7-0e30-4916-9dbc-245d4866dc75>\",\"WARC-IP-Address\":\"18.217.169.143\",\"WARC-Target-URI\":\"https://www.vbforums.com/showthread.php?891566-How-do-we-remake-the-program-to-copy-not-one-value-value-but-with-range-in-column-age&s=b0ceb3097af4244d5a0432fa1747428b\",\"WARC-Payload-Digest\":\"sha1:RM7PXAERSHBSFN5QYFDX6XPHIFTQKI6W\",\"WARC-Block-Digest\":\"sha1:2NEYBJMDPCZBXWCAHUBGHEYIR23S66KP\",\"WARC-Identified-Payload-Type\":\"application/xhtml+xml\",\"warc_filename\":\"/cc_download/warc_2021/CC-MAIN-2021-25/CC-MAIN-2021-25_segments_1623487649688.44_warc_CC-MAIN-20210619172612-20210619202612-00277.warc.gz\"}"}