PLEASE HELP!! Is this possible in VBA????

wrightyrx7

wrightyrx7

Well-known Member
Joined
Sep 15, 2011
Messages
994
Hi all,

I have a big report i run at the end of every month with about 25 columns, with upto 1000 rows, and was wondering if this is possible.

example columns:-

Name, Surname, NI number, Earnings, 1,A,2,B,3,C,4,D,5,E,etc

The colums above will be on the main worksheet.

Then what we do at the moment is create extra blank worksheets to then copy an paste the columns with all the data like this:-
Worksheet2 - Name, Surname, NI number, Earnings, 1,A
Worksheet3 - Name, Surname, NI number, Earnings, 2,B
Worksheet4 - Name, Surname, NI number, Earnings, 3,C
Worksheet5 - Name, Surname, NI number, Earnings, 4,D
Worksheet2 - Name, Surname, NI number, Earnings, 5,E

Is there anthing that can be created to automatically create the other worksheets from the main one?

Thanks in advance.

Chris
 
Last edited:
Sort by date Sort by votes
Sorry I was wrong columns A through D are identical to the original columns in sheet 1 and are not controlled by any of the sheets. Hope this helps.
 
Upvote 0

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Fish you have been a great help. Not on my pc at the minute I'm on my fone, but will try it in the morning an let you know how its goes.

Thanks for all your help really appreciate it.

Chris
 
Upvote 0
I have ended up using the first coed and changing it to my needs. As follows:-

Sub SECOND_Create_Worksheets()

Worksheets.Add(After:=Worksheets(1)).Name = "GMPF Added Years"
Worksheets(1).Columns("A:G").Copy Destination:=Worksheets(2).Range("A1")
Worksheets(1).Columns("AK:AK").Copy Destination:=Worksheets(2).Range("H1")
Worksheets(1).Columns("BB:BB").Copy Destination:=Worksheets(2).Range("I1")

Worksheets.Add(After:=Worksheets(2)).Name = "GMPF Add Reg Cont"
Worksheets(1).Columns("A:G").Copy Destination:=Worksheets(3).Range("A1")
Worksheets(1).Columns("AL:AL").Copy Destination:=Worksheets(3).Range("H1")
Worksheets(1).Columns("BC:BC").Copy Destination:=Worksheets(3).Range("I1")

Worksheets.Add(After:=Worksheets(3)).Name = "GMPV AVC"
Worksheets(1).Columns("A:G").Copy Destination:=Worksheets(4).Range("A1")
Worksheets(1).Columns("AM:AM").Copy Destination:=Worksheets(4).Range("H1")
Worksheets(1).Columns("BD:BD").Copy Destination:=Worksheets(4).Range("I1")

Worksheets.Add(After:=Worksheets(4)).Name = "GMPF"
Worksheets(1).Columns("A:G").Copy Destination:=Worksheets(5).Range("A1")
Worksheets(1).Columns("AN:AN").Copy Destination:=Worksheets(5).Range("H1")
Worksheets(1).Columns("BE:BE").Copy Destination:=Worksheets(5).Range("I1")

Worksheets.Add(After:=Worksheets(5)).Name = "TP"
Worksheets(1).Columns("A:G").Copy Destination:=Worksheets(6).Range("A1")
Worksheets(1).Columns("AO:AO").Copy Destination:=Worksheets(6).Range("H1")
Worksheets(1).Columns("BF:BF").Copy Destination:=Worksheets(6).Range("I1")

Worksheets.Add(After:=Worksheets(6)).Name = "TP Add"
Worksheets(1).Columns("A:G").Copy Destination:=Worksheets(7).Range("A1")
Worksheets(1).Columns("AP:AP").Copy Destination:=Worksheets(7).Range("H1")
Worksheets(1).Columns("BG:BG").Copy Destination:=Worksheets(7).Range("I1")

Worksheets.Add(After:=Worksheets(7)).Name = "TP AVC"
Worksheets(1).Columns("A:G").Copy Destination:=Worksheets(8).Range("A1")
Worksheets(1).Columns("AQ:AQ").Copy Destination:=Worksheets(8).Range("H1")
Worksheets(1).Columns("BH:BH").Copy Destination:=Worksheets(8).Range("I1")

Worksheets.Add(After:=Worksheets(8)).Name = "TP PT Buy Back"
Worksheets(1).Columns("A:G").Copy Destination:=Worksheets(9).Range("A1")
Worksheets(1).Columns("AR:AR").Copy Destination:=Worksheets(9).Range("H1")
Worksheets(1).Columns("BI:BI").Copy Destination:=Worksheets(9).Range("I1")

Worksheets.Add(After:=Worksheets(9)).Name = "TP Step Down"
Worksheets(1).Columns("A:G").Copy Destination:=Worksheets(10).Range("A1")
Worksheets(1).Columns("AS:AS").Copy Destination:=Worksheets(10).Range("H1")
Worksheets(1).Columns("BJ:BJ").Copy Destination:=Worksheets(10).Range("I1")

End Sub
Click to expand...

I was wondering is there any way to get this to only copy the data that has values in the columns that are stated on line 3 & 4 of each code above?

Many Thanks

Chris
 
Upvote 0
You are looking to copy only the cells that contain data instead of then entire column correct? Are you trying to skip blank cells or just end the range at the last row? For example if your data looked like this:

<table border="0" cellpadding="0" cellspacing="0" width="128"><colgroup><col style="width:48pt" span="2" width="64"> </colgroup><tbody><tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt;width:48pt" height="17" width="64">Row</td> <td class="xl24" style="width:48pt" width="64">Data</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">1</td> <td class="xl24">A</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">2</td> <td class="xl24">B</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">3</td> <td class="xl24">C</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">4</td> <td class="xl24">
</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">5</td> <td class="xl24">E</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">6</td> <td class="xl24">F</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">7</td> <td class="xl24">G</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">8</td> <td class="xl24">
</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">9</td> <td class="xl24">I</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">10</td> <td class="xl24">J</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">11</td> <td class="xl24">
</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">12</td> <td class="xl24">
</td> </tr> <tr style="height:12.75pt" height="17"> <td class="xl24" style="height:12.75pt" height="17">13</td> <td class="xl24">
</td> </tr> </tbody></table>

Are you wanting to copy rows 1 through 10? Or rows 1-3, 5-7, and 9-10? Also does each column have the same number of rows?
 
Upvote 0
Hello again fish, it would be the rows 1-3, 5-7, and 9-10.

From my example:-
Worksheet2 - Name, Surname, NI number, Earnings, 1,A - only transfer Rows that have data in Column 1 or A
Worksheet3 - Name, Surname, NI number, Earnings, 2,B - only transfer Rows that have data in Column 2 or B
Worksheet4 - Name, Surname, NI number, Earnings, 3,C - only transfer Rows that have data in Column 3 or C
Worksheet5 - Name, Surname, NI number, Earnings, 4,D - only transfer Rows that have data in Column 4 or D
Worksheet2 - Name, Surname, NI number, Earnings, 5,E - only transfer Rows that have data in Column 5 or E

Not all the columns have the data on the same rows.

Hope I have explained it clear enough. Thanks for your patience with me.

Chris
 
Upvote 0
Try this

Code: 
Sub THIRD_Create_Worksheets()
Worksheets.Add(After:=Worksheets(1)).Name = "GMPF Added Years"
Worksheets.Add(After:=Worksheets(2)).Name = "GMPF Add Reg Cont"
Worksheets.Add(After:=Worksheets(3)).Name = "GMPV AVC"
Worksheets.Add(After:=Worksheets(4)).Name = "GMPF"
Worksheets.Add(After:=Worksheets(5)).Name = "TP"
Worksheets.Add(After:=Worksheets(6)).Name = "TP Add"
Worksheets.Add(After:=Worksheets(7)).Name = "TP AVC"
Worksheets.Add(After:=Worksheets(8)).Name = "TP PT Buy Back"
Worksheets.Add(After:=Worksheets(9)).Name = "TP Step Down"
With Worksheets(1)
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For Row = 2 To LastRow Step 1
    If .Range("AK" & Row) <> "" Or .Range("BB" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(2).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AK" & Row).Copy Destination:=Worksheets(2).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BB" & Row).Copy Destination:=Worksheets(2).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AL" & Row) <> "" Or .Range("BC" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(3).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AL" & Row).Copy Destination:=Worksheets(3).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BC" & Row).Copy Destination:=Worksheets(3).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AM" & Row) <> "" Or .Range("BD" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(4).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AM" & Row).Copy Destination:=Worksheets(4).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BD" & Row).Copy Destination:=Worksheets(4).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AN" & Row) <> "" Or .Range("BE" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(5).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AN" & Row).Copy Destination:=Worksheets(5).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BE" & Row).Copy Destination:=Worksheets(5).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("A0" & Row) <> "" Or .Range("BF" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(6).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AO" & Row).Copy Destination:=Worksheets(6).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BF" & Row).Copy Destination:=Worksheets(6).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AP" & Row) <> "" Or .Range("BG" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(7).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AP" & Row).Copy Destination:=Worksheets(7).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BG" & Row).Copy Destination:=Worksheets(7).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AQ" & Row) <> "" Or .Range("BH" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(8).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AQ" & Row).Copy Destination:=Worksheets(8).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BH" & Row).Copy Destination:=Worksheets(8).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AR" & Row) <> "" Or .Range("BI" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(9).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AR" & Row).Copy Destination:=Worksheets(9).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BI" & Row).Copy Destination:=Worksheets(9).Range("I65536").End(xlUp).Offset(1, 0)
    End If
    
    If .Range("AS" & Row) <> "" Or .Range("BJ" & Row) <> "" Then
        .Range("A" & Row, "G" & Row).Copy Destination:=Worksheets(10).Range("A65536").End(xlUp).Offset(1, 0)
        .Range("AS" & Row).Copy Destination:=Worksheets(10).Range("H65536").End(xlUp).Offset(1, 0)
        .Range("BJ" & Row).Copy Destination:=Worksheets(10).Range("I65536").End(xlUp).Offset(1, 0)
    End If
Next Row
End With
End Sub
 
Upvote 0
Thanks Fish, I think its working but its not copying column Titles, is there a reason for this?

Thanks

Chris
 
Upvote 0
Sorry forgot about column titles. Change this line

Code: 
For Row = 2 To LastRow Step 1

to

Code: 
For Row = 1 To LastRow Step 1
 
Upvote 0
Fish i could kiss ya!! haha

One problem the titles on the worksheets are on row 2 with the data underneath, row 1 is blank??

You have done a great job mate, this is goin to save us so so so much time. Cant thank you enough.

Chris
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
Creation of arrows for 2 family trees.
Replies
8
Views
372
harzer
H
J
  • Question Question
VBA Script to Update Files in a folder, updating Links
Replies
1
Views
542
Micron
M
O
  • Solved
VBA - Filter columns, cut/paste rows new sheet, pivot table
2
Replies
12
Views
305
Skyybot
Skyybot
W
  • Solved
VBA - Match two values from Table1 to two in Table2 and move/align
2
Replies
15
Views
255
Welshy1491
W
S
  • Solved
VBA: reference a cell value in a different worksheet with alternative worksheet
Replies
7
Views
344
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,518
Messages
6,179,248
Members
452,900
Latest member
LisaGo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top