Find and Paste the values from one Excel to Another

[venugosr]

Hi Team,

I need a help to copy and paste the values from One excel to another.
1. I have two excel sheet. One contains master data and other one need to send the details to client.
2. In the mater data i have columns ( Name, Emp id, No of days worked and Hours, etc) with emp details
3. The other one contains the same columns, but the emp details in different order.
4. From the master sheet i want to copy and pate the No of days worked and Hours to other sheet.
5. Now im doing copy and find and then pasting the details. It takes time. Will you help me to automate this process?
6. I have one coding, but it copy and paste the whole data from one excel to another. Please find the coding as well.

Kindly help me on this.

Thanks in advance.

Srikanth.V

<dl class="codebox"><dd><code>Sub copydata()
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim shttocopy As Worksheet
Dim wbname As String
' check if the file is open
ret = Isworkbookopen("H:\Srikanth\Book2.xlsm")
If ret = False Then
' open file
Set wkbSource = Workbooks.Open("H:\Srikanth\Book2.xlsm")
Else
'Just make it active
'Workbooks("C:\stack\file1.xlsx").Activate
Set wkbSource = Workbooks("Book2.xlsm")
End If
' check if the file is open
ret = Isworkbookopen("H:\Srikanth\Book1.xlsx")
If ret = False Then
' open file
Set wkbDest = Workbooks.Open("H:\Srikanth\Book1.xlsx")
Else
'Just make it active
'Workbooks("C:\stack\file2.xlsx").Activate
Set wkbDest = Workbooks("Book1.xlsx")
End If
'perform copy
Set shttocopy = wkbSource.Sheets("filedata")
shttocopy.Copy wkbDest.Sheets(3)
End Sub
Function Isworkbookopen(filename As String)
Dim ff As Long, ErrNo As Long
Dim wkb As Workbook
Dim nam As String
wbname = filename
On Error Resume Next
ff = FreeFile()
Open filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: Isworkbookopen = False
Case 70: Isworkbookopen = True
Case Else: Error ErrNo
End Select
End Function</code>
</dd></dl>