Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

copy excel data through VBA

Posted on 2011-04-24
4
Medium Priority
?
311 Views
Last Modified: 2012-05-11
Hi,
I have 3 workbooks (a, b, c) each containing some data in a worksheet
the data is a table format i.e continious rows and columns)
1) I need to copy the data of a, b and c in such a way that the table of b is copied two rows below the row where table a ends. and table of c is copied two rows below where table of b ends.
So at the end of this excercise i will have 3 tables one below the other in the nex xl sheet d.

The code will be executed from outside excel. the dimentions of the table has to be calculated at runtime.
0
Comment
Question by:PearlJamFanatic
  • 3
4 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35458085
TRIED AND TESTED

Is this what you want? Sample Files attached.

After you unzip the files, simply open the file "Run macro In Me.xls" and amend the macro "Sample" to reflect correct file names and paths as applicable. Once done, simply run the macro. The macro will create an output file called "Output" in the path that you specified with a format that you wanted.

Hope this helps.

Sid

Code Used

Const FileA As String = "C:\A.xls"
Const FileB As String = "C:\B.xls"
Const FileC As String = "C:\C.xls"
Const FileD As String = "C:\Output.xls" '<~~ For Output

Sub Sample()
    Dim wbA As Workbook, wbB As Workbook, wbC As Workbook, wbD As Workbook
    Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet
    Dim rA As Long, cA As Long, rB As Long, cB As Long, rC As Long, cC As Long, rD As Long
    
    Set wbA = Workbooks.Open(FileA)
    Set wsA = Sheets("Sheet1")
    rA = wsA.Range("A" & Rows.Count).End(xlUp).Row
    cA = wsA.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set wbB = Workbooks.Open(FileB)
    Set wsB = Sheets("Sheet1")
    rB = wsB.Range("A" & Rows.Count).End(xlUp).Row
    cB = wsB.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set wbC = Workbooks.Open(FileC)
    Set wsC = Sheets("Sheet1")
    rC = wsC.Range("A" & Rows.Count).End(xlUp).Row
    cC = wsC.Cells(1, Columns.Count).End(xlToLeft).Column
    
    '~~>Change Output Sheet Name Here
    Set wbD = Workbooks.Add
    Set wsD = Sheets("Sheet1")
    
    wsA.Range(wsA.Cells(1, 1).Address & ":" & wsA.Cells(rA, cA).Address).Copy wsD.Cells(1, 1)
    rD = wsD.Range("A" & Rows.Count).End(xlUp).Row + 3
    wsB.Range(wsB.Cells(1, 1).Address & ":" & wsB.Cells(rB, cB).Address).Copy wsD.Cells(rD, 1)
    rD = wsD.Range("A" & Rows.Count).End(xlUp).Row + 3
    wsC.Range(wsC.Cells(1, 1).Address & ":" & wsC.Cells(rC, cC).Address).Copy wsD.Cells(rD, 1)
    
    wbA.Close savechanges:=False
    wbB.Close savechanges:=False
    wbC.Close savechanges:=False
    wbD.SaveAs FileD
    wbD.Close savechanges:=False
    
    Set wbA = Nothing
    Set wbB = Nothing
    Set wbC = Nothing
    Set wbD = Nothing
    
    Set wsA = Nothing
    Set wsB = Nothing
    Set wsC = Nothing
    Set wsD = Nothing
    
    MsgBox "Done"
End Sub

Open in new window


Copy-Example.zip
0
 

Author Comment

by:PearlJamFanatic
ID: 35458115
Sorry I forgot to metnion that it has to be VBSCRIPT
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35458116
No probs :) Gimme 15 mins

Sid
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 2000 total points
ID: 35458139
TRIED AND TESTED

Ok Paste this code in a notepad and save the file as RunMe.VBS

Also Do remember to change the path of the files.

You may now directly run the vbs file to get the desired output.

Sid

Code

Const FileA = "C:\A.xls"
Const FileB = "C:\B.xls"
Const FileC = "C:\C.xls"
Const FileD = "C:\Output.xls" '<~~ For Output
Const xlUp = -4162 
Const xltoLeft = -4131

Dim oXL
Dim wbA, wbB, wbC, wbD
Dim wsA, wsB, wsC, wsD
Dim rA, cA, rB, cB, rC, cC, rD

Set oXL = CreateObject("Excel.Application")

Set wbA = oXL.Workbooks.Open(FileA)
Set wsA = wbA.Sheets("Sheet1")
rA = wsA.Range("A" & wsA.Rows.Count).End(xlUp).Row
cA = wsA.UsedRange.Columns.Count

Set wbB = oXL.Workbooks.Open(FileB)
Set wsB = wbB.Sheets("Sheet1")
rB = wsB.Range("A" & wsB.Rows.Count).End(xlUp).Row
cB = wsB.UsedRange.Columns.Count

Set wbC = oXL.Workbooks.Open(FileC)
Set wsC = wbC.Sheets("Sheet1")
rC = wsC.Range("A" & wsC.Rows.Count).End(xlUp).Row
cC = wsC.UsedRange.Columns.Count

'~~>Change Output Sheet Name Here
Set wbD = oXL.Workbooks.Add
Set wsD = wbD.Sheets("Sheet1")

wsA.Range("A1:" & wsA.Cells(rA, cA).Address).Copy wsD.Cells(1, 1)
rD = wsD.Range("A" & wsD.Rows.Count).End(xlUp).Row + 3
wsB.Range("A1:" & wsB.Cells(rB, cB).Address).Copy wsD.Cells(rD, 1)
rD = wsD.Range("A" & wsD.Rows.Count).End(xlUp).Row + 3
wsC.Range("A1:" & wsC.Cells(rC, cC).Address).Copy wsD.Cells(rD, 1)

wbA.Close False
wbB.Close False
wbC.Close False
wbD.SaveAs FileD
wbD.Close False

Set wbA = Nothing
Set wbB = Nothing
Set wbC = Nothing
Set wbD = Nothing

Set wsA = Nothing
Set wsB = Nothing
Set wsC = Nothing
Set wsD = Nothing

MsgBox "Done"

Open in new window

0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes a serious pitfall that can happen when deleting shapes using VBA.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

580 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