PDA

View Full Version : Solved: Copy data from 1 workbook into another



Hoopsah
06-18-2010, 02:41 AM
Hi

I have a master spreadsheet that will contain all phone data.

I have 3 user spreadsheets that create the phone data.

I am looking for a bit of code that will copy the data from the users spreadsheet and insert it into the master spreadsheet by appending it on to the existing data.

Then delete the original user data so it is ready for use the next day.

Each user spreadsheet will have 3 different tabs that need copying

Any help appreciated

Cheers

Hoopsah

mdmackillop
06-18-2010, 03:10 AM
You're mixing up workbook and spreadsheet terms. Can you post a sample Master and User workbook to show correct sheet names and layouts.

Hoopsah
06-18-2010, 03:16 AM
Hi

copies attached

The file that ends John Fergie is the users spreadsheet and I want to copy the details from the tabs entitled database into the corresponding tabs in the other workbook.

Hoopsah
06-18-2010, 06:17 AM
OK,

I have got it working ok now, unless the original worksheet has no information then it crashes.

Anybody help me with putting in a check if no data option.

I am using:
Sub Update_Incoming_Call_Master_John_Fergie()
'
' Macro1 Macro
' Macro recorded 18/06/2010 by Gerry McNally
'
'
Application.ScreenUpdating = False
Workbooks.Open Filename:="I:\Customer Connections\Finance\Gerry\Front End Performance Management\Front End Performance Management John Fergie.xls"
Sheets("Incoming Call Database").Select
Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Front End Performance Management V.1.1.xls").Activate
Sheets("Incoming Call Database").Select
Range("A1").Select
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Windows("Front End Performance Management John Fergie.xls").Activate
Application.CutCopyMode = False
Selection.ClearContents
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True
Windows("Front End Performance Management V.1.1.xls").Activate
Sheets("Worksheet").Select
End Sub

Hoopsah
06-21-2010, 04:19 AM
BUMP! :dunno

mdmackillop
06-21-2010, 03:31 PM
Hi Gerry,
Give this a try

Option Explicit
Sub Update_Incoming_Call_Master_John_Fergie()
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rngSource As Range
Dim wsTgt As Worksheet
Dim rngTgt As Range
Dim Rws As Long

Application.ScreenUpdating = False
'Get paste location
Set wsTgt = ActiveWorkbook.Sheets("Incoming Call Database")
Set rngTgt = wsTgt.Cells(Rows.Count, 1).End(xlUp)(2)

'Get data to copy
Set wbSource = Workbooks.Open(Filename:="I:\Customer Connections\Finance\Gerry\Front " & _
"End Performance Management\Front End Performance Management John Fergie.xls")
Set wsSource = wbSource.Sheets("Incoming Call Database")
Set rngSource = wsSource.Cells(1, 1).CurrentRegion.Offset(1)
Rws = rngSource.Rows.Count - 1

'Copy data, if any
If Application.CountA(rngSource) > 0 Then
rngSource.Cut rngTgt
Application.CutCopyMode = False
wbSource.Close True
MsgBox Rws & " rows copied"
Else
wbSource.Close False
MsgBox "No data to copy"
End If
Application.ScreenUpdating = True
End Sub

Hoopsah
06-22-2010, 04:15 AM
Works like a charm MD

Thanks for your help

Gerry