Solved

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

Posted on 2003-12-03
16
2,621 Views
Last Modified: 2012-06-27
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



Thanks
fordraiders
0
Comment
Question by:fordraiders
  • 7
  • 4
  • 3
  • +2
16 Comments
 
LVL 80

Expert Comment

by:byundt
ID: 9871078
Hi fordraiders,
VBA can get data from a closed workbook using techniques like shown here http://j-walk.com/ss/excel/tips/tip82.htm

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.

Cheers!

Brad
0
 
LVL 3

Author Comment

by:fordraiders
ID: 9871664
byunt,
Thats ok as long as I don't see it open...
or if not fine....
0
 
LVL 3

Author Comment

by:fordraiders
ID: 9871791
All,

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
           Sheets(1).UsedRange.Copy
           'Close the x file without saving
 ActiveWorkbook.Close SaveChanges:=False
            'Window through to AppendData
             Windows("AppendData.xls").Activate
            '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
    Else
 '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


0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 9872554
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

Cheers

Dave


0
 
LVL 3

Author Comment

by:fordraiders
ID: 9872779
To All,,

o.k.  
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
usedRng.Copy

    Workbooks.Open Filename:="C:\iCart\File For Batchmatch Processing.xls"
    Windows("File For Batchmatch Processing.xls").Activate
    With ActiveWorkbook
        Sheets("Input Template").Select
        Range("A2").Select
        ActiveSheet.Paste
    End With
    Range("A1").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
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, _
     SearchOrder:=xlByRows).Row
If FirstRow = 1 Then FirstRow = 2
FirstCol = Cells.find(What:="*", _
     SearchDirection:=xlNext, _
     SearchOrder:=xlByColumns).Column
LastRow = Cells.find(What:="*", _
     SearchDirection:=xlPrevious, _
     SearchOrder:=xlByRows).Row
LastCol = Cells.find(What:="*", _
     SearchDirection:=xlPrevious, _
     SearchOrder:=xlByColumns).Column
Set theRng = Range(Cells(FirstRow, FirstCol), _
   Cells(LastRow, LastCol))
handleError:
End Sub


Thanks
fordraiders
0
 
LVL 24

Assisted Solution

by:R_Rajesh
R_Rajesh earned 250 total points
ID: 9873302
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")
tWb.Sheets("MyNewData").Activate
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
oXl.Quit
Set oXl = Nothing
Set tWb = Nothing
End Sub
---------------------------------
0
 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9873349
well if any of the columns in MyNewData are totally blank, then the code copies the column header to OriginalDataPost,  to fix it

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

with
tWb.Sheets("MyNewData").Range(Cells(2, i), Cells(IIf(lr = 1, 2, lr), i)).Copy
0
 
LVL 17

Expert Comment

by:smozgur
ID: 9873986
fordraiders,

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

For example :
Column A : Numeric
Column B : Text
...
...

Thanks
Suat
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 17

Accepted Solution

by:
smozgur earned 250 total points
ID: 9874250
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----

Suat
(PS: It doesn't need to open workbook)
0
 
LVL 3

Author Comment

by:fordraiders
ID: 9874657
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.


Thanks
fordraiders
0
 
LVL 3

Author Comment

by:fordraiders
ID: 9874663
smozgur,

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

For example :
Column A : Numeric
Column B : Text

Answer:

All text.....

0
 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9874761
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



0
 
LVL 3

Author Comment

by:fordraiders
ID: 9874786
Rajesh,
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...


Thanks
fordraiders
0
 
LVL 3

Author Comment

by:fordraiders
ID: 9874891
smozgur,
How is your code opening up the workbook/worksheet to paste the data into?

I have the other workbook in a different folder.

Thanks
fordraiders
0
 
LVL 17

Expert Comment

by:smozgur
ID: 9883680
fordraiders,

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"

Also:

>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
0
 
LVL 17

Expert Comment

by:smozgur
ID: 9883756
Err... Sorry :

DAO = Data Access Objects

Suat
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

In case Office 2010 has not been deployed in your environment, this article may be quite useful. In our office, we wanted a way to deploy Microsoft Office Professional Plus 2010 through an automated batch file via logon script. This article is docum…
In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

26 Experts available now in Live!

Get 1:1 Help Now