copy paste

[Legacy 450448]

my file name
1.xls
leverage.xlsx
vba code will be placed in a seperate file macro.xlsm
all files are located in same place
code has to open the file and it should do the process and save and close all the file


If column B of 1.xlsx matches with column A of leverage.xlsx then copy column D of leverage.xlsx and paste it to column J of 1.xlsx

sheet name can be anything in both the files

 

[DanteAmor]

Try this

Sub Copy_paste()
  Dim b1 As Workbook, b2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
  Dim c As Range, f As Range
  Application.ScreenUpdating = False
  Set b1 = Workbooks.Open("1.xlsx")
  Set b2 = Workbooks.Open("leverage.xlsx")
  Set sh1 = b1.Sheets(1)
  Set sh2 = b2.Sheets(1)
  For Each c In sh1.Range("B1", sh1.Range("B" & Rows.Count).End(xlUp))
    Set f = sh2.Range("A:A").Find(c, , xlValues, xlWhole)
    If Not f Is Nothing Then
      sh1.Cells(c.Row, "J").Value = sh2.Cells(f.Row, "D")
    End If
  Next
  b1.Save
  b1.Close False
  b2.Close False
  MsgBox "Done"
End Sub

 

[Legacy 450448]

i am gettin error
run time error 1004
method range of object worksheet failed
highlighted line For Each c In sh1.Range("B1", sh1.Range("B" & Rows.Count).End(xlUp))


i have modifiedt the code bcoz it contains error but after modifcation also it contains error plz have a look Sir

Sub Copy_paste()
Dim b1 As Workbook, b2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
Dim c As Range, f As Range
Application.ScreenUpdating = False
Set b1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")
Set b2 = Workbooks.Open(ThisWorkbook.Path & "\Leverage.xlsb")
Set sh1 = b1.Sheets(1)
Set sh2 = b2.Sheets(1)
For Each c In sh1.Range("B1", sh1.Range("B" & Rows.Count).End(xlUp))
Set f = sh2.Range("A:A").Find(c, , xlValues, xlWhole)
If Not f Is Nothing Then
sh1.Cells(c.Row, "J").Value = sh2.Cells(f.Row, "D")
End If
Next
b1.Save
b1.Close False
b2.Close False
MsgBox "Done"
End Sub

 

[DanteAmor]

i am gettin error
run time error 1004
method range of object worksheet failed
highlighted line For Each c In sh1.Range("B1", sh1.Range("B" & Rows.Count).End(xlUp))

The code is correct, it works for me.


What version of Office and Excel do you have?

 

[Legacy 450448]

2013 Sir

 

[DanteAmor]

What version is this file: "\ 1.xls" looks like 2003 or earlier.

Change this line:

[/COLOR][COLOR=#333333]For Each c In sh1.Range("B1", sh1.Range("B" & Rows.Count).End(xlUp))

By:

For Each c In sh1.Range("B1", sh1.Range("B" & 65536).End(xlUp))

Note:
Can you convert the 1.xls file to a newer version?
****** id="cke_pastebin" style="position: absolute; top: 40px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">
Set f = sh2.Range("A:A").Find(c, , xlValues, xlWhole)</body>

 

[Legacy 450448]

Thnx Alot Sir for giiving ur precious time and Great Support to this post Sir
Have a Great Day Sir

 

[DanteAmor]

Im glad to help you. Thanks for the feedback.