Thanks Thanks:  0
Likes Likes:  0
Page 3 of 3 FirstFirst 123
Results 21 to 24 of 24

Thread: Extract data from one workbook to another

  1. #21
    Board Regular
    Join Date
    Feb 2002
    Location
    Las Vegas Nevada USA
    Posts
    239
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Eureka it works.
    However the Tab name is supposed to copy to column C. It does but does not change with the info. In other words it copies the Tab name of the first sheet for all three cycles of the loop.
    George

    Learn to listen. Opportunity sometimes knocks very softly.

  2. #22
    Board Regular
    Join Date
    Feb 2002
    Location
    Las Vegas Nevada USA
    Posts
    239
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Oh and here's the code:

    Sub ImportJob()
    'Imports all data for a new job into Pay Verification2
    Dim JobCode As Variant
    Dim sht As Worksheet
    Dim CurrentSheetName As Variant
    '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
    'Assign the sheet name to a variable
    CurrentSheetName = ActiveSheet.Name
    'Open the target workbook
    Workbooks("Pay Verification2.xls").Activate
    With Workbooks("Pay Verification2").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
    CurrentSheetName = Null
    '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
    Workbooks("Pay Verification2.xls").Activate

    Exit Sub
    George

    Learn to listen. Opportunity sometimes knocks very softly.

  3. #23
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Change:

    Selection.FormulaR1C1 = CurrentSheetName

    To:

    Selection.FormulaR1C1 = sht.Name

    and/or

    Change:

    CurrentSheetName = ActiveSheet.Name

    To:

    CurrentSheetName = sht.Name






    [ This Message was edited by: TsTom on 2002-04-28 22:47 ]

  4. #24
    Board Regular
    Join Date
    Feb 2002
    Location
    Las Vegas Nevada USA
    Posts
    239
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Aaaaaannnnnnnnd the MASTER has spoken and his word is like a thunderbolt from the mountain. You deserve to be elevated to
    MVP for this.

    HEAR THAT MR EXCEL

    My gratitude knows no bounds. I will be the office hero thanks to you Tom.
    Have a great evening. ("Whats left of it)
    George

    Learn to listen. Opportunity sometimes knocks very softly.

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •