Advertisement

There's no such thing as a stupid question, but they're the easiest to answer.
Login
Search

Advertisement

Business Applications Business Applications
Search Search
Search for:
Tech Support Guy > > >

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


(!)

fufukitty's Avatar
fufukitty fufukitty is offline
Junior Member with 1 posts.
THREAD STARTER
 
Join Date: Nov 2009
Experience: Beginner
05-Nov-2009, 04:35 PM #1
Wink Oh Excel Macro Gurus - pelase help with extracting data into new worksheet
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

Last edited by fufukitty; 05-Nov-2009 at 04:41 PM..
Rollin_Again's Avatar
Member with 4,693 posts.
 
Join Date: Sep 2003
Location: Atlanta, GA - Planet Earth
Experience: Advanced
05-Nov-2009, 09:30 PM #2
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
Aj_old's Avatar
Aj_old Aj_old is offline
Computer Specs
Senior Member with 869 posts.
 
Join Date: Sep 2007
Location: Moldova
Experience: Intermediate
06-Nov-2009, 04:00 AM #3
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

BBC, Reader's Digest, PC Magazine, Today Show, Money Magazine
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.


Tags
excel macro copy paste

(clock)
THIS THREAD HAS EXPIRED.
Are you having the same problem? We have volunteers ready to answer your question, but first you'll have to join for free. Need help getting started? Check out our Welcome Guide.

Search Tech Support Guy

Find the solution to your
computer problem!




Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools


WELCOME
You Are Using: Server ID
Trusted Website Back to the Top ↑