Copy data from One workbook sheet to Another closed workbook sheet via VBA only

excel 2000

win 2000 sp4

Current Workbook name  "OriginalData.xls
Current worksheet name  "MyNewData"

Closed Workbook name  "NewData.xls
Closed worksheet name  "OriginalDataPost"

What I need:

Copy data from current worksheet to Another Closed Workbook worksheet.

However, Here is the tricky part....

Here is how I need to match up...

On "MyNewData"               On "OriginalDataPost"

ColumnD to        TO              ColumnA

ColumnA       TO                  ColumnB

ColumnB       TO                  ColumnC

ColumnC         TO               ColumnD

Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

byundtMechanical EngineerCommented:
Hi fordraiders,
VBA can get data from a closed workbook using techniques like shown here

Worksheet formula functions can get data from a closed workbook--VLOOKUP, MATCH and INDEX being three particularly useful ones for this purpose.

But I don't know any way to write to a closed workbook. I think you'll have to open it first.


FordraidersAuthor Commented:
Thats ok as long as I don't see it open...
or if not fine....
FordraidersAuthor Commented:

This will do it.... but...
I was hoping to revamp for as question asks

Sub ImportData()
Dim fs
Dim i As Integer
Dim Myfile As String
Dim intAppendRow As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set fs = Application.FileSearch
With fs
 .LookIn = "C:\daVE"
  'The "*" a wildcard character
 .FileName = "*.xls"
  If .Execute > 0 Then
      'We have found some files
  For i = 1 To .FoundFiles.Count
        'Pass the first file name to the String MyFile
  Myfile = .FoundFiles(i)
         'Open the x file
  Workbooks.Open (Myfile)
           'Copy the entire range on Sheet1
           'Close the x file without saving
 ActiveWorkbook.Close SaveChanges:=False
            'Window through to AppendData
            'Go to the last blank cell in column A and paste
Range("a65532").End(xlUp).Offset(1, 0).Select
Range("a65532").End(xlUp).Offset(1, 0).PasteSpecial
  Next i 'Open next .xls
 'There are no .xls files in directory specified
     MsgBox "There were no files found."
  End If
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Good News: You can write to a closed workbook using ADO/DAO
Bad News: You'll probably have to wait for Suat to answer this

I'll send him an email



FordraidersAuthor Commented:
To All,,

I got this to work....
But Now I have a new problem...

After I determine a new range using this passing function...

ColumnA and ColumnB   may not always have data in them..
But I need the Function include these Columns anyway....

Sub PasteValues()

        Sheets("PreBatchmatch").Select    'Sheet you want to copy

 ' determine data
  Dim usedRng As Range
DetermineUsedRange usedRng

' temp just as an fyi  
 MsgBox usedRng.Address

    Workbooks.Open Filename:="C:\iCart\File For Batchmatch Processing.xls"
    Windows("File For Batchmatch Processing.xls").Activate
    With ActiveWorkbook
        Sheets("Input Template").Select
    End With
End Sub

' nice way to determine a used range of data in case you have Row 1 has Column Headers
Sub DetermineUsedRange(ByRef theRng As Range)
Dim FirstRow As Integer, FirstCol As Integer, _
   LastRow As Integer, LastCol As Integer
On Error GoTo handleError
FirstRow = Cells.find(What:="*", _
     SearchDirection:=xlNext, _
If FirstRow = 1 Then FirstRow = 2
FirstCol = Cells.find(What:="*", _
     SearchDirection:=xlNext, _
LastRow = Cells.find(What:="*", _
     SearchDirection:=xlPrevious, _
LastCol = Cells.find(What:="*", _
     SearchDirection:=xlPrevious, _
Set theRng = Range(Cells(FirstRow, FirstCol), _
   Cells(LastRow, LastCol))
End Sub

try this:

the code opens the NewData.xls in the background and copies the data to it from the MyNewData sheet. if OriginalDataPost already contains data, then the new data will be appended to the end.

Sub mycopy()
Dim oXl As Excel.Application
Dim oWb As Excel.Workbook
Dim tWb As Excel.Workbook
Dim oSh As Excel.Worksheet
Set oXl = CreateObject("excel.application")
oXl.Visible = False
Set tWb = ThisWorkbook
Set oWb = oXl.Workbooks.Open("c:\temp\NewData.xls")
Set oSh = oWb.Sheets("OriginalDataPost")
For i = 1 To 4
lr = IIf(Cells(65536, i) = "", Cells(65536, i).End(xlUp).Row, 65536)
Select Case i
Case 1: dc = "B" & IIf(oSh.Cells(65536, 2) = "", oSh.Cells(65536, 2).End(xlUp).Row, 65536)
If Len(dc = 2) And Right(dc, 1) = 1 Then dc = "B2"
Case 2: dc = "C" & IIf(oSh.Cells(65536, 3) = "", oSh.Cells(65536, 3).End(xlUp).Row, 65536)
If Len(dc = 2) And Right(dc, 1) = 1 Then dc = "C2"
Case 3: dc = "D" & IIf(oSh.Cells(65536, 4) = "", oSh.Cells(65536, 4).End(xlUp).Row, 65536)
If Len(dc = 2) And Right(dc, 1) = 1 Then dc = "D2"
Case 4: dc = "A" & IIf(oSh.Cells(65536, 1) = "", oSh.Cells(65536, 1).End(xlUp).Row, 65536)
If Len(dc = 2) And Right(dc, 1) = 1 Then dc = "A2"
End Select
tWb.Sheets("MyNewData").Range(Cells(2, i), Cells(lr, i)).Copy
oSh.Range(dc).PasteSpecial Paste:=xlValues
Next i
oWb.Close True
Set oSh = Nothing
Set oWb = Nothing
Set oXl = Nothing
Set tWb = Nothing
End Sub
well if any of the columns in MyNewData are totally blank, then the code copies the column header to OriginalDataPost,  to fix it

tWb.Sheets("MyNewData").Range(Cells(2, i), Cells(lr, i)).Copy

tWb.Sheets("MyNewData").Range(Cells(2, i), Cells(IIf(lr = 1, 2, lr), i)).Copy
Suat OzgurWeb / Application DeveloperCommented:

Is it possible to learn about your data types in MyNewData worksheet?

For example :
Column A : Numeric
Column B : Text

Suat OzgurWeb / Application DeveloperCommented:
Ok, we can solve the data type issue if you like this method and decide to use:

Using DAO, please Insert Microsoft DAO Library (VBA->Tools->References) : Late binding is also possible by using CreateObject method if you like.

Code goes into Standard module.

'----Code Start-----
Sub CopyDataToClosedWS()
'Requires Microsoft DAO Library - Tools->References
Dim dbeng As DAO.DBEngine
Dim dbmain As DAO.Database
Dim dbPath As String
Dim sht As Worksheet
Dim rng As Range
Dim cll As Range
    'Assuming workbooks are in the same folder
    dbPath = ThisWorkbook.Path & "\NewData.xls"
    Set dbeng = New DBEngine
    Set dbmain = dbeng.Workspaces(0).OpenDatabase(dbPath, False, False, "Excel 8.0;")
    Set sht = ThisWorkbook.Worksheets("MyNewData")
    'Assuming first row is title row in the source worksheet
    Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp)).Resize(, 4)
    For Each cll In rng.Rows
        dbmain.Execute "INSERT INTO [OriginalDataPost$] VALUES ('" & cll.Cells(1, 4) & _
                                                         "','" & cll.Cells(1, 1) & _
                                                         "','" & cll.Cells(1, 2) & _
                                                         "','" & cll.Cells(1, 3) & "')"
    Next cll
    dbmain.Close: Set dbmain = Nothing
    Set dbeng = Nothing
End Sub
'----Code End----

(PS: It doesn't need to open workbook)

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FordraidersAuthor Commented:
To  All,,,,,   Rajesh,
I'am copying the data to a totally different worksheet in a different workbook. Not the same workbook..

I already have my current workbook open. "OriginalData.xls"
worksheet selected  "MyNewData"
I determine my range of data.

copy it.
But only the data starting at Row2.

Open the different workbook   "NewData.xls
Select  the "OriginalDataPost" sheet in the worksheet ...I think I had "Input Template" in my propsed fix(sorry.....)
paste the data starting at row 2

Close the different workbook.

FordraidersAuthor Commented:

Your Question:
Is it possible to learn about your data types in MyNewData worksheet?

For example :
Column A : Numeric
Column B : Text


All text.....

hi ford,

thats exactly what the code does. copy and paste the code to the open
originaldata.xls. and execute the code

once executed the code, copies the columns form the current workbook i.e. originaldata.xls  to NewData.xls.  ofcourse you will have to change the path in the code

FordraidersAuthor Commented:
Sorry, Did not look at your variables close enough..
You are correct in syntax....

A tad bit slow...but it does work ...

Taking a look at smozgur code now...

FordraidersAuthor Commented:
How is your code opening up the workbook/worksheet to paste the data into?

I have the other workbook in a different folder.

Suat OzgurWeb / Application DeveloperCommented:

Sorry, I have no net connection at home and it took long time to reply your question.

See :

   dbPath = ThisWorkbook.Path & "\NewData.xls"

in code and change it with the path of your NewData.xls file. Just like below (sample)

   dbPath = "C:\SomeFolder\NewData.xls"


>All text.....

Good, I already wrote the code for All Text.

>How is your code opening up the workbook/worksheet to paste the data into?

As I already said, it doesn't open the workbook. It uses the workbook as the DATA SOURCE (like database) by using Data Application Objects (DAO). This is why Dave and me suggested this.

Suat OzgurWeb / Application DeveloperCommented:
Err... Sorry :

DAO = Data Access Objects

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.