Solved

Macro to pull data from various sheets

Posted on 2010-11-17
18
455 Views
Last Modified: 2012-05-10
Dear experts,

I have a file which has the below sheets with data sets in the below columns.
The data sets in each sheet is in different column.

Sheet Name      Data set 1      Data set 2      Data set 3      Data set 4      Data set 5      Data set 6
Os_sheet 1      A3:A1000      I3:I1000      U3:U1000      J3:J1000      K3:K1000      AH3:AH1000
ir_sheet 2      D10:D1000      F10:F1000      C10:C1000      H10:H1000      I10:I1000      AL10:AL000
IR_Sheet 3      D19:D1000      F19:F1000      C19:C1000      H19:H1000      I19:I1000      AM19:AM000
Op_Sheet 4      D26:D1000      F26:F1000      B26:B1000      E26:E1000      G26:G1000      BB26:BB1000


Need a macro which will pull the data from the various sheets and column ranges in to new sheet. This new sheet should be created as part of the macro

The data pulled by the above macro should be copied one below the other.

Thank you
0
Comment
Question by:Excellearner
  • 8
  • 6
  • 4
18 Comments
 
LVL 13

Expert Comment

by:gbanik
ID: 34160244
Assuming your data is in Sheet1, the following code should do it. Did i get your need right?
Dim oDataRange As Range, nCtr As Long
Set oDataRange = Application.Range("Sheet1!A1").CurrentRegion
For nCtr = 2 To oDataRange.Rows.Count
    Application.Worksheets.Add
    ActiveSheet.Name = Trim(oDataRange.Cells(nCtr, 1))
    oDataRange.Rows(nCtr).Offset(, 1).Copy
    ActiveSheet.Cells(1, 1).PasteSpecial , , , True
    ActiveSheet.Cells(1, 1).Select
Next

Open in new window

0
 
LVL 23

Expert Comment

by:Michael74
ID: 34161291
I read the requirements differently. This code will copy the listed ranges from each sheet and copies them into one column for each data set in a new worksheet.

The code does not assume that each range will be full and copies the data after the end of the last entry.

Sub copy()

   Dim lastRow As Long
   
   Application.Worksheets.Add After:=Worksheets(Worksheets.Count)
   
   lastRow = 2
   ActiveSheet.Range("A1").Value = "Data Set 1"
   Worksheets("Os_sheet 1").Range("A3:A1000").copy ActiveSheet.Range("A" & lastRow)
   lastRow = Cells(Rows.Count, "A").End(xlUp).Row
   Sheets("ir_sheet 2").Range("D10:D1000").copy ActiveSheet.Range("A" & lastRow)
   lastRow = Cells(Rows.Count, "A").End(xlUp).Row
   Sheets("IR_Sheet 3").Range("D19:D1000").copy ActiveSheet.Range("A" & lastRow)
   lastRow = Cells(Rows.Count, "A").End(xlUp).Row
   Sheets("Op_Sheet 4").Range("D26:D1000").copy ActiveSheet.Range("A" & lastRow)
   
   lastRow = 2
   ActiveSheet.Range("B1").Value = "Data Set 2"
   Sheets("Os_sheet 1").Range("I3:I1000").copy ActiveSheet.Range("B" & lastRow)
   lastRow = Cells(Rows.Count, "B").End(xlUp).Row
   Sheets("ir_sheet 2").Range("F10:F1000").copy ActiveSheet.Range("B" & lastRow)
   lastRow = Cells(Rows.Count, "B").End(xlUp).Row
   Sheets("IR_Sheet 3").Range("F19:F1000").copy ActiveSheet.Range("B" & lastRow)
   lastRow = Cells(Rows.Count, "B").End(xlUp).Row
   Sheets("Op_Sheet 4").Range("F26:F1000").copy ActiveSheet.Range("B" & lastRow)

   lastRow = 2
   ActiveSheet.Range("C1").Value = "Data Set 3"
   Sheets("Os_sheet 1").Range("U3:U1000").copy ActiveSheet.Range("C" & lastRow)
   lastRow = Cells(Rows.Count, "C").End(xlUp).Row
   Sheets("ir_sheet 2").Range("C10:C1000").copy ActiveSheet.Range("C" & lastRow)
   lastRow = Cells(Rows.Count, "C").End(xlUp).Row
   Sheets("IR_Sheet 3").Range("C19:C1000").copy ActiveSheet.Range("C" & lastRow)
   lastRow = Cells(Rows.Count, "C").End(xlUp).Row
   Sheets("Op_Sheet 4").Range("B26:B1000").copy ActiveSheet.Range("C" & lastRow)
   
   lastRow = 2
   ActiveSheet.Range("D1").Value = "Data Set 4"
   Sheets("Os_sheet 1").Range("J3:J1000").copy ActiveSheet.Range("D" & lastRow)
   lastRow = Cells(Rows.Count, "D").End(xlUp).Row
   Sheets("ir_sheet 2").Range("H10:H1000").copy ActiveSheet.Range("D" & lastRow)
   lastRow = Cells(Rows.Count, "D").End(xlUp).Row
   Sheets("IR_Sheet 3").Range("H19:H1000").copy ActiveSheet.Range("D" & lastRow)
   lastRow = Cells(Rows.Count, "D").End(xlUp).Row
   Sheets("Op_Sheet 4").Range("E26:E1000").copy ActiveSheet.Range("D" & lastRow)

   lastRow = 2
   ActiveSheet.Range("E1").Value = "Data Set 5"
   Sheets("Os_sheet 1").Range("K3:K1000").copy ActiveSheet.Range("D" & lastRow)
   lastRow = Cells(Rows.Count, "E").End(xlUp).Row
   Sheets("ir_sheet 2").Range("I10:I1000").copy ActiveSheet.Range("E" & lastRow)
   lastRow = Cells(Rows.Count, "E").End(xlUp).Row
   Sheets("IR_Sheet 3").Range("I19:I1000").copy ActiveSheet.Range("E" & lastRow)
   lastRow = Cells(Rows.Count, "E").End(xlUp).Row
   Sheets("Op_Sheet 4").Range("G26:G1000").copy ActiveSheet.Range("E" & lastRow)
   
   lastRow = 2
   ActiveSheet.Range("F1").Value = "Data Set 6"
   Sheets("Os_sheet 1").Range("AH3:AH1000").copy ActiveSheet.Range("D" & lastRow)
   lastRow = Cells(Rows.Count, "E").End(xlUp).Row
   Sheets("ir_sheet 2").Range("AL10:AL1000").copy ActiveSheet.Range("E" & lastRow)
   lastRow = Cells(Rows.Count, "E").End(xlUp).Row
   Sheets("IR_Sheet 3").Range("AM19:AM1000").copy ActiveSheet.Range("E" & lastRow)
   lastRow = Cells(Rows.Count, "E").End(xlUp).Row
   Sheets("Op_Sheet 4").Range("BB26:BB1000").copy ActiveSheet.Range("E" & lastRow)

End Sub

Open in new window

0
 

Author Comment

by:Excellearner
ID: 34164323
Hi Michael,

Thank you for the comment.

I ran the macro, and it populated the first data field from sheet 1 into a new sheet and then gave the following error message:

1.run time error subscript out of range.


Kindly help.

Thank you
0
 
LVL 13

Expert Comment

by:gbanik
ID: 34164873
@Excellearner
Did i understand your need right? If not, please advice.
0
 

Author Comment

by:Excellearner
ID: 34165899
Gbanik,

the data fields are in several sheets in different columns,

Hence a macro is required to pull the data from vairous sheets and put the similar data fields one below the other (coming from various sheets) and different data fields in different columns.

thank you
0
 
LVL 13

Expert Comment

by:gbanik
ID: 34165929
So it means... i did the exact opposite of what u wanted? (please see my code)
If yes, I could rework it back ;)
0
 

Author Comment

by:Excellearner
ID: 34165959
Gbanik,

I do not think the code is right.

Thank you, coudl you please help me

0
 
LVL 13

Expert Comment

by:gbanik
ID: 34166439
Almost done ... one bit of info...
Do u need the Project Names or the Dataset as the columns in the new sheet?
I am guessing it is Dataset.
0
 
LVL 13

Expert Comment

by:gbanik
ID: 34166906
Ok... didnt get a reply so going by my assumption.

Here is the file attached and the code to do so.

Rum CNTRL + SHFT + X to run the macro

.... I had to fill dummy data to satisfy all your ranges... hence the file size.
Also, your had some of the ranges addresses wrong....Data set 6....AL10:AL000 and AM19:AM000
Fetchdata.zip
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 23

Expert Comment

by:Michael74
ID: 34167956
Excel learner

I ran my script against some test data and it worked
There was a small bug that put the data out of alignment but that is corrected.

If this still does not work could you please post your data for me to test against

test.zip
0
 

Author Comment

by:Excellearner
ID: 34168735
gbanik,

I tried themacro on my sheet a nd i got the following error message.
method 'range' of object'_ application failed'.

Michael,

I tried the macro susggested by you and i got the folowing error message:

run time error 9
subscript out of range

Kindly help.

Thank you,

0
 
LVL 13

Expert Comment

by:gbanik
ID: 34168766
I just download the zip file and tested again... it works.

Did u check the macro on my file?

Are you trying to use my macro on your sheet and it failed?
0
 

Author Comment

by:Excellearner
ID: 34168822
Gbanik

thank you for the time.

Yes it worked on your file but it failed on my file.

Becasuse of confidentiality i am not able to share the file.

Thank you
0
 
LVL 13

Expert Comment

by:gbanik
ID: 34168844
If you can share the piece of code that failed I may be able to help you.
0
 
LVL 23

Expert Comment

by:Michael74
ID: 34169928
Excellearner

I will second gbaniks suggestion, unless of course you can overwrite the sensitive data in the original file with some test data. Just use the drag option to copy down. Any column not used can simply be deleted
0
 

Author Comment

by:Excellearner
ID: 34173324
Michael and Gbanik,

Thank you,

Please find attached my live file.

Thank you
test-macro.xls
0
 
LVL 13

Accepted Solution

by:
gbanik earned 250 total points
ID: 34173700
Run CNTRL + SHFT + X

all working!!! same code...

u had a lot of errors in the reference table .... ranges as well as sheet names.
test-macro.xls
0
 
LVL 23

Assisted Solution

by:Michael74
Michael74 earned 250 total points
ID: 34177521
The sheet names did not match. All fixed


test-macro-1.xls
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now