1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Oh Excel Macro Gurus - pelase help with extracting data into new worksheet

Discussion in 'Business Applications' started by fufukitty, Nov 5, 2009.

Thread Status:
Not open for further replies.
Advertisement
  1. fufukitty

    fufukitty Thread Starter

    Joined:
    Nov 5, 2009
    Messages:
    1
    It's been a while since I have done this and I can kind of picture in my head what I need...

    I have 50 surveys (source) that I need to extract certain data points and copy/paste them into another spreadsheet. I can get to the point of opening each survey with an input box and copying the cells in the source but it is the paste that is failing me...the way I have it set up right now the next survey I open will overwrite the previous survey - I need to make this dynamic so that the next survey I open it will go to the summary file, locate the next empty Row and start importing data. Moving cell to cell - to the right until complete.

    Please help

    See Code:
    Dim xl As Excel.Application
    Dim wb As Excel.Workbook
    Dim wb1 As Excel.Workbook
    Dim ws As Excel.Worksheet
    Dim ws1 As Excel.Worksheet
    Dim sSurveyPath As String
    'Dim sMainPath As String
    Dim iSheet As Integer

    'input box
    Dim sMyInput As String
    sMyInput = InputBox("Enter the Store Number", _
    "Survey Store Number", "Enter Store Number HERE")
    If sMyInput = "Enter Store Number HERE" Or _
    sMyInput = "" Then
    Exit Sub
    End If

    'Summary
    Set wb = ThisWorkbook

    'Loop through Each Sheet in this workbook
    For iSheet = 1 To 3
    Select Case iSheet
    Case 1
    sSheet = "Vendor Info"
    Case 2
    sSheet = "Newspaper Info"
    Case 3
    sSheet = "Rack Info"
    End Select

    'source
    sSurveyPath = "E:\Myfiles\Client\Surveys\Survey_" & sMyInput & ".xls"
    'sMainPath = "E:\Myfiles\Client\Client Surveys.xls"

    Set xl = Excel.Application
    Set wb1 = xl.Workbooks.Open(sSurveyPath)
    xl.Visible = True
    xl.DisplayAlerts = False
    Set ws1 = wb1.Worksheets("Sheet1")


    'Finds next empty row
    ws.Range("A1").End(xlDown).Select

    'vendor2
    wb1.Worksheets("Sheet1").Range("C1").Copy Destination:=wb.Worksheets(sSheet).Range("A3")
    wb1.Worksheets("Sheet1").Range("C22").Copy Destination:=wb.Worksheets(sSheet).Range("B3")
    wb1.Worksheets("Sheet1").Range("C23").Copy Destination:=wb.Worksheets(sSheet).Range("C3")
    wb1.Worksheets("Sheet1").Range("H22").Copy Destination:=wb.Worksheets(sSheet).Range("D3")
    wb1.Worksheets("Sheet1").Range("H23").Copy Destination:=wb.Worksheets(sSheet).Range("E3")
    wb1.Worksheets("Sheet1").Range("H24").Copy Destination:=wb.Worksheets(sSheet).Range("F3")
    wb1.Worksheets("Sheet1").Range("C24").Copy Destination:=wb.Worksheets(sSheet).Range("G3")
    wb1.Worksheets("Sheet1").Range("C25").Copy Destination:=wb.Worksheets(sSheet).Range("H3")
    wb1.Worksheets("Sheet1").Range("H25").Copy Destination:=wb.Worksheets(sSheet).Range("I3")
    wb1.Worksheets("Sheet1").Range("H26").Copy Destination:=wb.Worksheets(sSheet).Range("J3")

    'vendor3
    wb1.Worksheets("Sheet1").Range("C1").Copy Destination:=wb.Worksheets(sSheet).Range("A3")
    wb1.Worksheets("Sheet1").Range("C22").Copy Destination:=wb.Worksheets(sSheet).Range("B3")
    wb1.Worksheets("Sheet1").Range("C23").Copy Destination:=wb.Worksheets(sSheet).Range("C3")
    wb1.Worksheets("Sheet1").Range("H22").Copy Destination:=wb.Worksheets(sSheet).Range("D3")
    wb1.Worksheets("Sheet1").Range("H23").Copy Destination:=wb.Worksheets(sSheet).Range("E3")
    wb1.Worksheets("Sheet1").Range("H24").Copy Destination:=wb.Worksheets(sSheet).Range("F3")
    wb1.Worksheets("Sheet1").Range("C24").Copy Destination:=wb.Worksheets(sSheet).Range("G3")
    wb1.Worksheets("Sheet1").Range("C25").Copy Destination:=wb.Worksheets(sSheet).Range("H3")
    wb1.Worksheets("Sheet1").Range("H25").Copy Destination:=wb.Worksheets(sSheet).Range("I3")
    wb1.Worksheets("Sheet1").Range("H26").Copy Destination:=wb.Worksheets(sSheet).Range("J3")
    Next iSheet
     
  2. Rollin_Again

    Rollin_Again

    Joined:
    Sep 4, 2003
    Messages:
    4,732
    Are you talking about Copy Destination:=wb.Worksheets(sSheet).Range("A3")
    and then B3, C3, etc. ??? Is this what you need to be made dynamic using the next available row?

    Regards,
    Rollin
     
  3. Aj_old

    Aj_old

    Joined:
    Sep 24, 2007
    Messages:
    869
    1. As I can see from your example, your main book is a 3 sheet workbook, and you copy the information from 1 spreadsheet (sh) to each of this 3 shs, so you just have the same info in 3 different shs. Is this how you wanna it to be?
    2. As your code is designed you need to run the code and specify the name of the survey workbook, through an input box, for each of your 50 surveys. ?
    3. you specified this code
    Code:
    Set ws1 = wb1.Worksheets("Sheet1")
    , but you don't use it after this, when you copy the values, instead you just wrote the wb1.Worksheets("Sheet1"), in the time you could use just ws1, for example:
    Code:
    ws1.Range("C1").Copy Destination:=wb.Worksheets(sSheet).Range("A3")
    , instead of this
    Code:
    wb1.Worksheets("Sheet1").Range("C1").Copy Destination:=wb.Worksheets(sSheet).Range("A3")
    4. You found the next empty row, but you also don't use this info in your code.
    Code:
    'Finds next empty row
    ws.Range("A1").End(xlDown).Select
    You should change it to
    Code:
            'Finds next empty row
            xrow = shres.Range("A3").End(xlDown).Row
    , this will give you the number of the next empty row.

    5. If I understood right, you wanna each survey in a new row, am I right? In this case you need to specify the destination cell, using some variables, like
    Code:
    wb1.Worksheets("Sheet1").Range("C1").Copy Destination:=wb.Worksheets(sSheet).Range("A" & xrow)
    6. What happens when you reopen a survey for which you already have the information in the main workbook, or such a situation is excluded?
    7. Why do you have the copy paste part twice, you a just doing the same thing twice, and it does not change any thing.
     
As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/874755