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

[wrightyrx7]

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

 

[hiker95]

wrightyrx7,

What version of Excel are you using?

You will generally get much more help (and faster) in this forum if you can post your small samples (sensitive data scrubbed/removed/changed) (what you have and what you expect to achieve) directly in the forum.

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

 

[wrightyrx7]

Hi Hiker95,

Excel 2003.

I think the spreadsheet is wayyyy to big for a screenshot. An the column titles may confuse you cause they are codes from our payroll system.

Thanks for the quick reply

Chris

 

[jfish1288]

Just going off what you stated in your original post and assuming that the last worksheet should be worksheet6 not worksheet 2, I came up with this. It should get you started at least.

Sub newsheets()

    Worksheets.Add(After:=Worksheets(1)).Name = "Worksheet2"
    Worksheets(1).Columns("A:F").Copy Destination:=Worksheets(2).Range("A1")
    
    Worksheets.Add(After:=Worksheets(2)).Name = "Worksheet3"
    Worksheets(1).Columns("A:D").Copy Destination:=Worksheets(3).Range("A1")
    Worksheets(1).Columns("G:H").Copy Destination:=Worksheets(3).Range("E1")
        
    Worksheets.Add(After:=Worksheets(3)).Name = "Worksheet4"
    Worksheets(1).Columns("A:D").Copy Destination:=Worksheets(4).Range("A1")
    Worksheets(1).Columns("I:J").Copy Destination:=Worksheets(4).Range("E1")
        
    Worksheets.Add(After:=Worksheets(4)).Name = "Worksheet5"
    Worksheets(1).Columns("A:D").Copy Destination:=Worksheets(5).Range("A1")
    Worksheets(1).Columns("K:L").Copy Destination:=Worksheets(5).Range("E1")
        
    Worksheets.Add(After:=Worksheets(5)).Name = "Worksheet6"
    Worksheets(1).Columns("A:D").Copy Destination:=Worksheets(6).Range("A1")
    Worksheets(1).Columns("M:N").Copy Destination:=Worksheets(6).Range("E1")
    
End Sub

 

[wrightyrx7]

OMG JFISH!!

Your a genius!!! Sorry about the lack of screenshots but you managed without them!! That is absulutly PERFECT!! Im so happy you have to saved me soooo much time.

Thank you very very much!

 

[jfish1288]

glad i could help

 

[wrightyrx7]

Think this is a whole new kettle of fish but is there a way that if for some reason i update the data on the worksheets it will update on the WORKSHEET1?

Your vba is perfect this is just a general question.

Thanks again

 

[jfish1288]

This will update sheets2-6 if you change the cell values in sheet 1

Sub newsheets()
    
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    
    Worksheets.Add(After:=Worksheets(1)).Name = "Worksheet2"
    Worksheets(2).Range("A1", "F" & lastrow).FormulaR1C1 = "=Sheet1!RC"
    
    Worksheets.Add(After:=Worksheets(2)).Name = "Worksheet3"
    Worksheets(3).Range("A1", "D" & lastrow).FormulaR1C1 = "=Sheet1!RC"
    Worksheets(3).Range("E1", "F" & lastrow).FormulaR1C1 = "=Sheet1!RC[2]"
        
    Worksheets.Add(After:=Worksheets(3)).Name = "Worksheet4"
    Worksheets(4).Range("A1", "D" & lastrow).FormulaR1C1 = "=Sheet1!RC"
    Worksheets(4).Range("E1", "F" & lastrow).FormulaR1C1 = "=Sheet1!RC[4]"
        
    Worksheets.Add(After:=Worksheets(4)).Name = "Worksheet5"
    Worksheets(5).Range("A1", "D" & lastrow).FormulaR1C1 = "=Sheet1!RC"
    Worksheets(5).Range("E1", "F" & lastrow).FormulaR1C1 = "=Sheet1!RC[6]"
        
    Worksheets.Add(After:=Worksheets(5)).Name = "Worksheet6"
    Worksheets(6).Range("A1", "D" & lastrow).FormulaR1C1 = "=Sheet1!RC"
    Worksheets(6).Range("E1", "F" & lastrow).FormulaR1C1 = "=Sheet1!RC[8]"

End Sub

It is important to note that this will update the cells on the sheets 2 through 6 if you change the values on sheet 1, but if you add rows to sheet 1 you will loose data on the other sheets. If you are going to add rows you might want to change

lastrow = Range("A" & Rows.Count).End(xlUp).Row

to

lastrow = Range("A" & Rows.Count).End(xlUp).Row +100

or some number that makes sense for your application. But note that this will put zeros on sheets 2-6 in cells that are unused on sheet 1

 

[jfish1288]

Sorry I just reread your question and I think I did the exact opposite of what you are asking. I think that what you are asking might be possible but not that practical. I will give it a little thought though

 

[jfish1288]

I think this might do the trick. Same comments about adding rows and such. Also columns A through D are controlled by sheet 2

Sub newsheets1()

    Worksheets.Add(After:=Worksheets(1)).Name = "Worksheet2"
    Worksheets(1).Columns("A:F").Copy Destination:=Worksheets(2).Range("A1")
    
    Worksheets.Add(After:=Worksheets(2)).Name = "Worksheet3"
    Worksheets(1).Columns("A:D").Copy Destination:=Worksheets(3).Range("A1")
    Worksheets(1).Columns("G:H").Copy Destination:=Worksheets(3).Range("E1")
        
    Worksheets.Add(After:=Worksheets(3)).Name = "Worksheet4"
    Worksheets(1).Columns("A:D").Copy Destination:=Worksheets(4).Range("A1")
    Worksheets(1).Columns("I:J").Copy Destination:=Worksheets(4).Range("E1")
        
    Worksheets.Add(After:=Worksheets(4)).Name = "Worksheet5"
    Worksheets(1).Columns("A:D").Copy Destination:=Worksheets(5).Range("A1")
    Worksheets(1).Columns("K:L").Copy Destination:=Worksheets(5).Range("E1")
        
    Worksheets.Add(After:=Worksheets(5)).Name = "Worksheet6"
    Worksheets(1).Columns("A:D").Copy Destination:=Worksheets(6).Range("A1")
    Worksheets(1).Columns("M:N").Copy Destination:=Worksheets(6).Range("E1")
    
    Worksheets.Add(After:=Worksheets(1)).Name = "Worksheet1"
    Worksheets(1).Columns("A:D").Copy Destination:=Worksheets("Worksheet1").Range("A1")
        
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Worksheets("Worksheet1").Range("E1", "F" & lastrow).FormulaR1C1 = "=Worksheet2!RC"
    Worksheets("Worksheet1").Range("G1", "H" & lastrow).FormulaR1C1 = "=Worksheet3!RC[-2]"
    Worksheets("Worksheet1").Range("I1", "J" & lastrow).FormulaR1C1 = "=Worksheet4!RC[-4]"
    Worksheets("Worksheet1").Range("K1", "L" & lastrow).FormulaR1C1 = "=Worksheet5!RC[-6]"
    Worksheets("Worksheet1").Range("M1", "N" & lastrow).FormulaR1C1 = "=Worksheet6!RC[-8]"
    
    Application.DisplayAlerts = False
    Worksheets(1).Delete
    Application.DisplayAlerts = True
    
End Sub