Extract data from one workbook to another

[GeorgeB]

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

 

[brettvba]

This message was edited by brettvba on 2002-04-28 20:06

 

[Legacy 98055]

Hi George...
You say it will only import from one sheet on the Job Code sheet?
I tested the code as I sent it and it pulled data from the ranges you selected from every sheet?
Have you stepped through the code to see what it is doing? Or not doing in this case...
Tom

 

[GeorgeB]

Tom
Yes I did. I tried the code as you sent it but it would not work. Something I did wrong perhaps. Did you run the code I just posted? It works well except for the problem I mentioned.

 

[GeorgeB]

Tom
Just stepped through it and it loops through fine the first time but when it goes back to the top of the loop the active sheet does not change. Could it be something with the CurrentSheetName being active. I have tried setting it back (CurrentSheetName = Nothing) but that gives an error.

 

[brettvba]

what about
CurrentSheetName = Null

 

[GeorgeB]

OK the error message is gone but the same problem still exists.
Thanks for keeping the thread alive Brett

 

[Legacy 98055]

Hi George.
If I understand your code, you need to open a job code workbook, named by the user, and copy from the same range on each sheet, and then paste to Pay Verification...
Is this correct?
That us the way I tested it...
Give me a few minutes.
Will need to mock it up a bit.

P.S. Edit

I just re-read your post and you mentioned that the individual Job Code workbooks are already open?
Also the only extraction will come from the default active sheet(Job Code Workbook)?
If that is the case, why are we looping through the Job Codes workbook?
Please explain...
Thanks,
Tom

P.S. Edit

Your quote:
"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."

do you mean:
Whatever sheet is active when it is activated."
It is already open? Correct?
This message was edited by TsTom on 2002-04-28 21:58

 

[GeorgeB]

Tom
First question. Yes the workbook named by the user (JobCode) is a group of houses and each sheet represents a single house. I need to extract the same range from each sheet (House) and paste it to Pay Verification to check the payroll against the budget. For some reason the loop cycles for as many sheets as JobCode has but only extract data from the sheet that is active. In other words in this case it extracts and pastes the same info 3 times because thats how many sheets are in this workbook. (Could be as many as 20 or 25)
To further clarify it only copies from one sheet three times instead of cycling through all the sheets.
_________________
George

Learn to listen. Opportunity sometimes knocks very softly.
This message was edited by GeorgeB on 2002-04-28 22:10

 

[Legacy 98055]

I found that error
Current sheet was for Pay Verification not Job Code...

Here is some edited code which I just tested and it seems to work fine..

Tom<pre>

Sub ImportJob()
'Imports all data for a new job into Pay Verification
Dim JobCode As Variant
Dim sht As Worksheet
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
'Copy the desired data
sht.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</pre>
This message was edited by TsTom on 2002-04-28 22:12

 

[Legacy 98055]

If you copied the code before I edited it, make sure you change this line:

Range("B18:D37").Copy

to:

sht.Range("B18:D37").Copy

Tom