asked on

copy data from one workbook to another vba

Hi all,
Need some assistance please. Trying to copy data from one workbook into another.

Currently I have it so by activating the macro you select the excel workbook to import. I want to copy the entire data on the sheet in the imported macro, and paste into a sheet called "Raw data" on the main macro workbook (let's call it Macro.xlm).

Here is what I have so far, getting stuck on the determing the range, copying, and pasting.

Sub UploadMan()
  Set wkbThis = ThisWorkbook
  
  ' Open Client Workbook
  Set wkbClient = OpenWorkbook(True)
  ' Set wkbClient = OpenWorkbook1()
  
  If wkbClient Is Nothing Then
    MsgBox "No valid workbook has been provided, Exiting..."
    Exit Sub
  Else
    If (wkbClient.Worksheets.Count > 0) Then
       Set wsClient = wkbClient.Worksheets(1)
    Else
       MsgBox "Unable to process - no worksheet available"
       Exit Sub
    End If
    
    If (wsClient Is Nothing) Then
      MsgBox "Null client worksheet..."
      Exit Sub
    Else
    End If
     End If
     'copy data from workbook into macro - NEED HELP from here on...
    Dim rng As Range
     Set rng = Range("A1:R" & Range("R" & Rows.Count).End(xlUp).Row)'
'is there a better way to just set the range? i want to grab everything thats in the sheet
     rng.Copy
    Dim ws As Worksheet
    Application.ScreenUpdating = False
'need to create the sheet on Macro.xlm
    Set ws = Worksheets("Raw Data")
     'end copy
   ' Close the client file, no saves of any changes
    wkbClient.Close SaveChanges:=False
End Sub

Open in new window

thanks!

Steven Harris

To clarify:

-You want to open a workbook;
-Copy the data from the active sheet;
-Paste data to the workbook that is running the macro (Tab = "Raw Data");
-Close the workbook you just imported from

Is that about it?

byundt

I revised your macro so it will copy data from a second workbook and paste it in the workbook containing the macro in worksheet Raw Data. If worksheet Raw Data doesn't exist, one will be created. The copied data will be appended to the bottom of existing data on Raw Data.

The macro assumes that you have an existing sub OpenWorkbook that will let the user select a workbook and open it.

Sub UploadMan()
Dim wkbClient As Workbook, wkbThis As Workbook
Dim ws As Worksheet, wsClient As Worksheet
Dim rng As Range, targ As Range
Set wkbThis = ThisWorkbook
  
  ' Open Client Workbook
Set wkbClient = OpenWorkbook(True)      'This statement doesn't work on my computer. I assume you have a sub called OpenWorkbook.
  ' Set wkbClient = OpenWorkbook1()
  
If wkbClient Is Nothing Then
    MsgBox "No valid workbook has been provided, Exiting..."
    Exit Sub
Else
    If (wkbClient.Worksheets.Count > 0) Then
        Set wsClient = wkbClient.Worksheets(1)
    Else
        MsgBox "Unable to process - no worksheet available"
        Exit Sub
    End If
End If
     
     'copy data from workbook into macro - NEED HELP from here on...
Application.ScreenUpdating = False
     'Set rng = Range("A1:R" & Range("R" & Rows.Count).End(xlUp).Row) '
Set rng = wsClient.UsedRange
'is there a better way to just set the range? i want to grab everything thats in the sheet
'need to create the sheet on Macro.xlm
On Error Resume Next
Set ws = Worksheets("Raw Data")
If ws Is Nothing Then
    Set ws = wkbThis.Worksheets.Add(After:=wkbThis.Worksheets(wkbThis.Worksheets.Count))
    ws.Name = "Raw Data"
End If
On Error GoTo 0

With ws
    Set targ = .UsedRange
    Set targ = targ.Cells(targ.Rows.Count + 1, 1)
End With

'rng.Copy targ       'Copy formulas, values & formatting
targ.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value    'Copy just the values
     'end copy
   ' Close the client file, no saves of any changes
wkbClient.Close SaveChanges:=False
End Sub

Open in new window

eastsidemarket

ASKER

byundt - looks great thanks.

however it adds a blank line above the data on the Raw Data tab. Anyway to not have that extra blank line up top?

would it be this piece?
Set targ = targ.Cells(targ.Rows.Count + 1, 1)

thanks.

ASKER CERTIFIED SOLUTION

byundt

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

eastsidemarket

ASKER

awesome, nice work!