Macro to split data

G

Gemz

I have a sheet with data and I need to use it for different things – I am
using different bits of the data all the time because I need to produce a
few different reports from the same data set. Is there a way I can get a
macro to actually produce all the different reports that I want? For example,
I would like to macro to firstly name a new tab in the workbook as ‘Report 1’
then enter the specified columns that I want into that named sheet. For
example, in sheet named ‘Report 1’ I would like to see columns A,B,C,G,H,Y,Z
and then in the same workbook I would like to get another sheet renamed to
‘Report 2’ and then copy columns ‘D,E,J,K,L’ and then finally another sheet
to be renamed to ‘Report 3’ and then copy across columns ‘AA, AB, AC’ . And I
might need to repeat this a couple more times.

Thanks in advance.
 
J

Joel

Sub MakeReports()

Report1Col = Array("A", "B", "C", "G", "H", "Y", "Z")
Report2Col = Array("D", "E", "J", "K", "L")
Report3Col = Array("AA", "AB", "AC")


With ThisWorkbook
.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set RPT1 = ActiveSheet
RPT1.Name = "Report1"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set RPT2 = ActiveSheet
RPT2.Name = "Report2"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set RPT3 = ActiveSheet
RPT3.Name = "Report3"

With Sheets("Data")
ColCount = 1
For Each col In Report1Col
.Columns(col).Copy _
Destination:=RPT1.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In Report2Col
.Columns(col).Copy _
Destination:=RPT2.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In Report3Col
.Columns(col).Copy _
Destination:=RPT3.Columns(ColCount)
ColCount = ColCount + 1
Next col

End With
End With

End Sub
 
M

Mike H

Perhaps

Insert into a module

Sub stantial()
For x = 1 To 3
Worksheets.Add
ActiveSheet.Name = "Report " & x
Next

Set myrange1 = Sheets("Sheet1").Range("A:A,B:B,C:C,G:G,H:H,Y:Y,Z:Z")
Set myrange2 = Sheets("Sheet1").Range("D:D:J:J:K:K:L:L")
Set myrange3 = Sheets("Sheet1").Range("AA:AA,AB:AB,AC:AC")

myrange1.Copy
Sheets("Report 1").Range("A1").PasteSpecial
myrange2.Copy
Sheets("Report 2").Range("A1").PasteSpecial
myrange3.Copy
Sheets("Report 3").Range("A1").PasteSpecial

End Sub

Mike
 
G

Gemz

Hi,

thanks for the prompt reply, that worked great. I was thinking would this be
easy enough to change into a userform type of thing? For example, when
someone else uses the same sheet a form would appear asking them what data
they want to extract onto a new tab and what they want the tab to be called
etc?

thanks again.
 
J

Joel

you code will put the new sheets in a new workbook unles you have AFTER

from
Worksheets.Add
to
Worksheets.Add after:=sheets(sheets.count)
 
G

Gemz

I dont understand, was this how i can make it like a userform input - so the
user themselves specify what columns and the sheet name etc? sorry if i didnt
make it clear before.

thanks.
 
M

Mike H

Not on my pc it doesn't

Joel said:
you code will put the new sheets in a new workbook unles you have AFTER

from
Worksheets.Add
to
Worksheets.Add after:=sheets(sheets.count)
Click to expand...
 
D

Dave Peterson

I think you've confused:

worksheets("sheet1").copy
or
worksheets("sheet1").move

with
worksheets.add
 
G

Gemz

Hi Joel,

Its been a few weeks since i last spoke to you about the below Joel, but i
modified the code you gave for my own stuff but somehow it does something
weird but not want i want it to!

Here is my code with my own info in it. I have added my own sheet names but
dont know what im doing wrong. The original code can be found in the original
post. Please help. thanks so much.

Sub splitdata()

AAACol = Array("A", "B", "C")
BBBCol = Array("D", "E")
CCCcol = Array("F")
DDDcol = Array("G", "H")


With ThisWorkbook
.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set AAA = ActiveSheet
AAA.Name = "AAA"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set BBB = ActiveSheet
BBB.Name = "BBB"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set CCC = ActiveSheet
CCC.Name = "CCC"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set DDD = ActiveSheet
DDD.Name = "DDD"

With Sheets("XXX")
ColCount = 1
For Each col In AAACol
.Columns(col).Copy _
Destination:=AAA.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In BBBCol
.Columns(col).Copy _
Destination:=BBB.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In CCCCol
.Columns(col).Copy _
Destination:=CCC.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In DDDCol
.Columns(col).Copy _
Destination:=DDD.Columns(ColCount)
ColCount = ColCount + 1
Next col

End With
End With

End Sub
 
D

Dave Peterson

I'm not Joel, but you may want to explain what that weird thing is.

Maybe it's because you didn't qualify this line:
With Sheets("XXX")
as
With .Sheets("XXX")
 
G

Gemz

Hi Dave,

I changed the line to: With .Sheets("XXX")

but now when i run the macro it runs but highlights the above line and the
tab in my spreadsheet which was called XXX changes to DDD (which is the last
thing specified in my code).

I dont know why thats happening! Thanks for your help.
 
D

Dave Peterson

I don't see anything in your code that would do this.

I assumed that Sheets("xxx") was part of the workbook that owned the code--that
it belonged under the "with Thisworkbook" line.

Is that correct?

And did you change anything else in your code?

If you did, it's time to repost it.
Hi Dave,

I changed the line to: With .Sheets("XXX")

but now when i run the macro it runs but highlights the above line and the
tab in my spreadsheet which was called XXX changes to DDD (which is the last
thing specified in my code).

I dont know why thats happening! Thanks for your help.
Click to expand...
 
G

Gemz

Hi,

I didnt change anything, below is my code. Just to explain what i am doing:

Sub splitdata()

AAACol = Array("A", "B", "C")
BBBCol = Array("D", "E")
CCCcol = Array("F")
DDDcol = Array("G", "H")


With ThisWorkbook
.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set AAA = ActiveSheet
AAA.Name = "AAA"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set BBB = ActiveSheet
BBB.Name = "BBB"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set CCC = ActiveSheet
CCC.Name = "CCC"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set DDD = ActiveSheet
DDD.Name = "DDD"

With.Sheets("XXX")
ColCount = 1
For Each col In AAACol
.Columns(col).Copy _
Destination:=AAA.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In BBBCol
.Columns(col).Copy _
Destination:=BBB.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In CCCCol
.Columns(col).Copy _
Destination:=CCC.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In DDDCol
.Columns(col).Copy _
Destination:=DDD.Columns(ColCount)
ColCount = ColCount + 1
Next col

End With
End With

End Sub


the AAA,BBB,CCC,DDD Are the names i want to give to 4 new sheets in the
workbook. XXX is the current sheet with all the data which will split into
each of the AAA,BBB,CCC,DDD depending on the criteria they meet.

As the code states certain columns from sheet XXX would be copied into AAA
then BBB etc.

I used the original code given by Joel and just substituted the names in
there for mine.. i dont know what i have done wrong! although the bit in
Joels code which said RPT1, RPT2 etc.. i was unsure of here and just
re-stated AAA,BBB etc.

Also, now somehow my macros in the personal.xls book have disappeared! it
reported and error and then they just disappeared? i dont have the option of
selecting from personal.xls book. i know this is unrelated to the above but
is there any way i can sort this?

Thanks alot.
 
D

Dave Peterson

change:
With.Sheets("XXX")
to
With .Sheets("XXX")


Hi,

I didnt change anything, below is my code. Just to explain what i am doing:

Sub splitdata()

AAACol = Array("A", "B", "C")
BBBCol = Array("D", "E")
CCCcol = Array("F")
DDDcol = Array("G", "H")

With ThisWorkbook
.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set AAA = ActiveSheet
AAA.Name = "AAA"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set BBB = ActiveSheet
BBB.Name = "BBB"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set CCC = ActiveSheet
CCC.Name = "CCC"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set DDD = ActiveSheet
DDD.Name = "DDD"

With.Sheets("XXX")
ColCount = 1
For Each col In AAACol
.Columns(col).Copy _
Destination:=AAA.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In BBBCol
.Columns(col).Copy _
Destination:=BBB.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In CCCCol
.Columns(col).Copy _
Destination:=CCC.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In DDDCol
.Columns(col).Copy _
Destination:=DDD.Columns(ColCount)
ColCount = ColCount + 1
Next col

End With
End With

End Sub

the AAA,BBB,CCC,DDD Are the names i want to give to 4 new sheets in the
workbook. XXX is the current sheet with all the data which will split into
each of the AAA,BBB,CCC,DDD depending on the criteria they meet.

As the code states certain columns from sheet XXX would be copied into AAA
then BBB etc.

I used the original code given by Joel and just substituted the names in
there for mine.. i dont know what i have done wrong! although the bit in
Joels code which said RPT1, RPT2 etc.. i was unsure of here and just
re-stated AAA,BBB etc.

Also, now somehow my macros in the personal.xls book have disappeared! it
reported and error and then they just disappeared? i dont have the option of
selecting from personal.xls book. i know this is unrelated to the above but
is there any way i can sort this?

Thanks alot.
Click to expand...
 
D

Dave Peterson

Depending on the version of excel you're running, maybe your personal.xls file
was marked as bad and was disabled.

Open excel
Help|About MS Excel|Click the Disabled Items button

Try to re-enable it.
Hi,

I didnt change anything, below is my code. Just to explain what i am doing:

Sub splitdata()

AAACol = Array("A", "B", "C")
BBBCol = Array("D", "E")
CCCcol = Array("F")
DDDcol = Array("G", "H")

With ThisWorkbook
.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set AAA = ActiveSheet
AAA.Name = "AAA"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set BBB = ActiveSheet
BBB.Name = "BBB"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set CCC = ActiveSheet
CCC.Name = "CCC"

.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set DDD = ActiveSheet
DDD.Name = "DDD"

With.Sheets("XXX")
ColCount = 1
For Each col In AAACol
.Columns(col).Copy _
Destination:=AAA.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In BBBCol
.Columns(col).Copy _
Destination:=BBB.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In CCCCol
.Columns(col).Copy _
Destination:=CCC.Columns(ColCount)
ColCount = ColCount + 1
Next col

ColCount = 1
For Each col In DDDCol
.Columns(col).Copy _
Destination:=DDD.Columns(ColCount)
ColCount = ColCount + 1
Next col

End With
End With

End Sub

the AAA,BBB,CCC,DDD Are the names i want to give to 4 new sheets in the
workbook. XXX is the current sheet with all the data which will split into
each of the AAA,BBB,CCC,DDD depending on the criteria they meet.

As the code states certain columns from sheet XXX would be copied into AAA
then BBB etc.

I used the original code given by Joel and just substituted the names in
there for mine.. i dont know what i have done wrong! although the bit in
Joels code which said RPT1, RPT2 etc.. i was unsure of here and just
re-stated AAA,BBB etc.

Also, now somehow my macros in the personal.xls book have disappeared! it
reported and error and then they just disappeared? i dont have the option of
selecting from personal.xls book. i know this is unrelated to the above but
is there any way i can sort this?

Thanks alot.
Click to expand...
 
G

Gemz

Hi,

It appears to have enabled the personal.xls but it doesnt let me do
anything, everytime i go to play the macro it keeps reporting error and
recovers my docs and then repeats the whole process everytime i want to go
and play the macros. please help!! i have a tonne of macros in the
personal.xls book.

Also, any advise on getting the macro working? because it still isnt. Would
you like me to send you my workbook so you can see? but this can only be done
on your personal email...

thanks for your help!
 
D

Dave Peterson

It sounds like your personal.xls file is really corrupted.

I'd throw away that copy of the file and put a backup version in its place.

No thanks to the offer of sending me a file.
Hi,

It appears to have enabled the personal.xls but it doesnt let me do
anything, everytime i go to play the macro it keeps reporting error and
recovers my docs and then repeats the whole process everytime i want to go
and play the macros. please help!! i have a tonne of macros in the
personal.xls book.

Also, any advise on getting the macro working? because it still isnt. Would
you like me to send you my workbook so you can see? but this can only be done
on your personal email...

thanks for your help!
Click to expand...
 
G

Gemz

Hi,

it doesnt seem to make a difference what file i open, every excel file i
open it just doesnt let me do anything in the macro menu, it just keeps
reporting error. i have even tried on a fresh new excel sheet and still no
difference...

thanks
 
D

Dave Peterson

What are you trying and what error do you see?
Hi,

it doesnt seem to make a difference what file i open, every excel file i
open it just doesnt let me do anything in the macro menu, it just keeps
reporting error. i have even tried on a fresh new excel sheet and still no
difference...

thanks
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Bypass error message to debug 5
Realign Columns? Imossible? 6
Compare two sheets, then copy/paste if different 3
Find/Replace Macro; Need Loop 7
Match several values in ‘Summary Sheet’ to several values in ‘Mast 4
Complex Compare Values, and Copy/Paste if in One Sheet but Not Oth 2
Compare and Copy/Paste b/w Two Workbooks 17
Set print area based on last row with a given value 3

Top