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

[Tom Schreiner]

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:

Windows("VMNB123.xls").Activate 

Should be:

Workbooks.Open YourPath & "/" & JobCode & ".xls"







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:





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







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 ]
		

[GeorgeB]

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??

[GeorgeB]

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 ???

[Tom Schreiner]

WorkBooks(JobCode).Activate

[GeorgeB]

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.

[Tom Schreiner]

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

[Tom Schreiner]

Try this out George

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

Tom

[GeorgeB]

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

[GeorgeB]

Any takers on this one??