Copying data from one workbook to another workbook

[Prakash M]

Hello Experts,

I would like your excel experts to help to copy data from 1 particular worksheet to another worksheet under a specific tab.

Below is my actual requirement:

1. I've a excel file named as Sample1, this sheet actually contains all the data which I consolidated / copied data from different sheets under "Consolidated" tab.
2. I've a another excel file named as Sample2 and it has some additional columns as compared to Sample1 file. In Sample2 file it has Status and Vendor # columns.
3. Now I want that - from Sample1 xls file, the same data should get copied to Sample2 xls file as per headers. Say "DISION" from Sample1 column should get copied to "DISION" column in Sample2 xls file.
4. This should actually get copied under "Master" tab in Sample2 xls file.

I want a code which will actually copy the data to a specific tab as defined in the code.

I've working on multiple data which is time consuming for me.

1st need to extract data from my internal applications. Than collate all the data into one worksheet after which I need to paste the same data to my working master xls file as per header names.

Your support will be highly appreciated.

Thanks

 

[Marc L]

Hi !

Where should be located the code ?
Are both files already opened when running the procedure ?
​

 

[Nebu]

Hi:

Here is the code I came up with based on what I understood from your post.

Sub test()
Dim cnStr As String, query As String, filename As String
Dim rs As ADODB.Recordset
Dim rng As Range, fnd As Range
Dim arr()

Application.ScreenUpdating = False
   
    arr = Array("DISION", "Plane", "Client", "No")
    Set rng = Me.Range("A1:F1")
    filename = ThisWorkbook.Path & "\Sample1.xlsx"

    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & filename & ";" & _
              "Extended Properties=Excel 12.0"
   
    For j% = LBound(arr) To UBound(arr)
        query = "SELECT " & arr(j) & " FROM [Consolidated$]"
        Set rs = New ADODB.Recordset
        rs.Open query, cnStr, adOpenStatic, adLockReadOnly
        For i% = 1 To 6
            Set fnd = rng.Find(What:=arr(j))
            Cells(2, fnd.Column).CopyFromRecordset rs
        Next
    Next
Application.ScreenUpdating = True
End Sub

You should paste this code in your sample 2 file and it will fetch data from your sample 1 workbook you do not have to open this workbook for the macro to work.

In VBA editor in tool references add the library Microsoft ActiveX Data Objects 6.1 Library, before running the code. Save both the files in the same folder.

Note: I have not coded anything to clear your existing data as you had not mentioned anything on that , play around with the code and let me know with questions if any.

Thanks

 

[Marc L]

A demonstration in case of both workbooks opened :​

Sub Demo()
             Dim Rg As Range
             Application.ScreenUpdating = False
    With Workbooks("Sample2.xlsx").Worksheets("Master").UsedRange
        For Each Rg In Workbooks("Sample1.xlsx").Worksheets("Consolidated").UsedRange.Columns
            V = Application.Match(Rg.Cells(1).Text, .Rows(1), 0)
             If IsNumeric(V) Then Rg.Copy .Cells(V)
        Next
    End With
             Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Prakash M]

Marc,

Excellent........it's working wonderful without any error. The sample sheets I'd provided was only for references. Now actually when I'm running this code with my actual data it's working like a charm.

I believe the data is getting copied to sample2 xls as per the headers we have in sample1 xls.

Tons of thanks......you really made my day and made me work more smoothly and smartly.

Regards,
Prakash

 

[Marc L]

Thanks !​

I believe the data is getting copied to sample2 xls as per the headers we have in sample1 xls.

Yes : if sample1 header is found in sample2 row #1,
sample1 column is copied to sample2 matching column …
​