Extract data from one workbook to another

GeorgeB

Board Regular
Joined
Feb 16, 2002
Messages
239
Can't seem to get the syntax right to open the workbook named in the input box. In this case VMNB123 but this will vary but it will be open at the same time as the target workbook. Is this a great forum or what?


Sub ImportJob()
'Imports all data for a new job
Dim JobCode As Variant
Dim sht As Variant
On Error GoTo errhand

JobCode = InputBox(prompt:="", Title:="INPUT THE JOB CODE")
If JobCode = "" Then
MsgBox prompt:="", Title:="NOTHING ENTERED"
Exit Sub
End If

Application.ScreenUpdating = False
Windows("VMNB123.xls").Activate
For Each sht In ActiveWorkbook.Worksheets
Windows("VMNB123.xls").Activate
Range("B18:D37").Select
Selection.Copy
Range("A1").Select
Windows("Pay Verification.xls").Activate
Range("E65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

Range("B65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
Selection.FormulaR1C1 = JobCode
Range("C65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
Selection.FormulaR1C1 = sht.Name
Range("D65536").End(xlUp).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
ActiveSheet.Paste
Range("H65536").End(xlUp).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(19, 0)).Select

ActiveSheet.Paste
Selection.NumberFormat = "0.00"
Application.CutCopyMode = False
Range("A1").Select

Next sht
errhand:
MsgBox prompt:="", Title:="ERROR, TRY AGAIN"

End Sub
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
George...

JobCode = InputBox(prompt:="", Title:="INPUT THE JOB CODE")
If JobCode = "" Then
MsgBox prompt:="", Title:="NOTHING ENTERED"
Exit Sub
End If

May be better if replaced with a GetOpenFileName statement.

The activate method is only for workbooks which are already opened...

This line in your code:<pre>

Windows("VMNB123.xls").Activate</pre>
Should be:<pre>

Workbooks.Open YourPath & "/" & JobCode & ".xls"<pre>

For example:

Lets assume all of the job code workbooks are in the following folder:

"C:Job Codes Workbooks"

Get your data from the inputbox:

As you stated, in this case, we will assume
"VMNB123.xls"

Use this syntax to open the workbook:<pre>

Workbooks.Open "C:Job Codes Workbooks" & JobCode & ".xls"<pre>

It is not really neccesary to include the file extension, but it is a good practice.

Is this what you are after?

Tom
This message was edited by TsTom on 2002-04-27 17:36
 
Upvote 0
Thanks for your reply Tom
Still working on it. So far I have this.

Workbooks.Open Filename:="C:Job Codes & JobCode & .xls"

But it won't go. "Cant be found" Used the macro recorder to get this far.

By the way how do you activate the workbook after it is open and on the 2nd time around in the loop??
 
Upvote 0
Almost there.
Anyone know the syntax to re-activate a workbook so info on the next sheet can be extracted??
Here's what I have.

Sub ImportJob()
'Imports all data for a new job
Dim JobCode As Variant
Dim sht As Variant
'On Error GoTo errhand

JobCode = InputBox(prompt:="", Title:="INPUT THE JOB CODE")
If JobCode = "" Then
MsgBox prompt:="", Title:="NOTHING ENTERED"
Exit Sub
End If

Application.ScreenUpdating = False
Workbooks.Open Filename:="C:Job Codes" & JobCode & ".xls"
For Each sht In ActiveWorkbook.Worksheets

Windows("VMNB123.xls").Activate 'THIS WORKS BUT ONLY FOR THIS WORKBOOK
'NEED SOME CODE TO REACTIVATE THE WORKBOOK NAMED AS A VARIABLE
'Windows JobCode & ".xls".Activate 'THIS DOES NOT WORK ???
 
Upvote 0
Must be getting close but it extracts data from one sheet of the variable workbook only and ignores the others.
I appreciate your help Tom.
 
Upvote 0
Hi George...
I'm looking at your code and trying to help you out...
I'm assuming that this procedure is being run from "Pay Verification.xls"?
What is the name of the sheet in "Pay Verification.xls" that is recieving the paste?
Thanks,
Tom
 
Upvote 0
Try this out George

<pre>


Sub ImportJob()
'Imports all data for a new job
Dim JobCode As Variant
Dim sht As Worksheet
Dim CurrentSheetName As String
On Error GoTo errhand

CurrentSheetName = ActiveSheet.Name
JobCode = InputBox(prompt:="", Title:="INPUT THE JOB CODE")
If JobCode = "" Then
MsgBox prompt:="", Title:="NOTHING ENTERED"
Exit Sub
End If

Application.ScreenUpdating = False
Workbooks.Open Filename:="C:Job Codes" & JobCode & ".xls"
For Each sht In Workbooks(JobCode).Worksheets
Range("B18:D37").Copy
Workbooks("Pay Verification").Activate
With Workbooks("Pay Verification").Sheets(CurrentSheetName)
.Range("E65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
.Range("B65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
.Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
Selection.FormulaR1C1 = JobCode
.Range("C65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
.Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
Selection.FormulaR1C1 = sht.Name
.Range("D65536").End(xlUp).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
.Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
.Paste
.Range("H65536").End(xlUp).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
.Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
.Paste
Selection.NumberFormat = "0.00"
Application.CutCopyMode = False
.Range("A1").Select
End With
Next sht
Workbooks(JobCode).Close savechanges:=False
Exit Sub
errhand:
MsgBox prompt:="", Title:="ERROR, TRY AGAIN"

End Sub


</pre>
Tom
 
Upvote 0
Tom
Here’s the code with your modifications and a few of my own. Yes the procedure is run from Pay Verification and the workbook JobCode will already be open. The Network is too big for the computer to go looking for it. The sheet name being pasted to in Pay Verification (the only sheet) is INPUT but can be changed.
This code will loop for as many sheets that are in JobCode but will only extract info from one sheet. Whatever sheet is active when it is opened.
Thanks again for your help.

Sub ImportJob()
'Imports all data for a new job into Pay Verification
Dim JobCode As Variant
Dim sht As Worksheet
Dim CurrentSheetName As Variant ‘(Sheet names can be alphanumeric)
On Error GoTo errhand

'Ask for the Job Code
JobCode = InputBox(prompt:="", Title:="INPUT THE JOB CODE")
If JobCode = "" Then
MsgBox prompt:="", Title:="NOTHING ENTERED"
Exit Sub
End If
Application.ScreenUpdating = False
'Open the Job inputed by user
'Loop through the workbook and extract the data
Workbooks(JobCode).Activate
For Each sht In Workbooks(JobCode).Worksheets
CurrentSheetName = ActiveSheet.Name
'Copy the desired data
Range("B18:D37").Copy
'Open the target workbook
Workbooks("Pay Verification.xls").Activate
With Workbooks("Pay Verification").Sheets("INPUT")
.Range("E65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
'Paste in the data
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'Paste in the Job name (JobCode)
.Range("B65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
.Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
Selection.FormulaR1C1 = JobCode
'Paste in the sheet name
.Range("C65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
.Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
Selection.FormulaR1C1 = CurrentSheetName
'Extend the formulas down
.Range("D65536").End(xlUp).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
.Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
.Paste
.Range("H65536").End(xlUp).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
.Range(ActiveCell, ActiveCell.Offset(19, 0)).Select
.Paste
Application.CutCopyMode = False
.Range("A1").Select
End With
Workbooks(JobCode).Activate
Next sht
Exit Sub

errhand:
MsgBox prompt:="", Title:="ERROR, TRY AGAIN"

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,184
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top