Macro to create new worksheet for each column, keeping first 2 columns in each new worksheet

[sharicn]

Hello!

I have a worksheet with about 32 columns that I download periodically as people buy raffle tickets for an event we're putting on. In order to upload the raffle tickets to our random raffle picker application, I need to divide the bigger worksheet into individual worksheets - one sheet for each raffle item. I played with some code on my own, then did a search here and found this, which gets me partway there:

Sub copycols()
Dim LC As Long, i As Long, ws As Worksheet
With ActiveSheet
    LC = .Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 2 To LC
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        .Columns(1).Copy Destination:=ws.Range("A1")
        .Columns(i).Copy Destination:=ws.Range("B1")
        ws.Name = Range("B1").Value
    Next i
End With
End Sub

My only issue, that I can't quite figure out on my own, is that I need both column A AND column B to copy to each new worksheet, and the worksheets to be named from the value in cell C1 (well, that part is easy, lol). Each time I think I have it logically figured out, I get an error. I'm sure it's something obvious I'm missing, but my VBA skills are a little rusty.

Any help would be greatly appreciated.

Thanks,
Shari

 

[My Aswer Is This]

You said:
one sheet for each raffle item
Does this mean the raffle item is in row(1) of each column in sheet named Master

So on each new sheet you want to see columns 1 and 2 of the sheet named master
And then the next column on sheet master
So first time it would be columns A B and C
Next sheet would have columns A B and D
And so on. Is that correct?

 

[sharicn]

You said:
one sheet for each raffle item
Does this mean the raffle item is in row(1) of each column in sheet named Master

So on each new sheet you want to see columns 1 and 2 of the sheet named master
And then the next column on sheet master
So first time it would be columns A B and C
Next sheet would have columns A B and D
And so on. Is that correct?

The data for raffle purchasers is in multiple rows beneath my header row, and the number of tickets purchased for each raffle item is in each column (see below). But you are absolutely correct in how I want the sheets to appear: first sheet, columns A B and C, second sheet, columns A B and D and so on.

Name	Email	Raffle Item 1	Raffle Item 2	Raffle Item 3
John Smith	john@smith.com	2	0	1
Bob Jones	bob@jones.com	0	5	25

 

[Peter_SSs]

See if this does what you want. I have assumed the sheet with data as shown in post #3 is the active sheet when the code is run. If that assumption may be incorrect then please confirm the name of that sheet.

Test with a copy of your workbook.

Sub Create_Sheets()
  Dim LastCol As Long, c As Long
  Dim wsOrig As Worksheet, ws As Worksheet
  
  Set wsOrig = ActiveSheet
  LastCol = wsOrig.Cells(1, Columns.Count).End(xlToLeft).Column
  Application.ScreenUpdating = False
  For c = 3 To LastCol
    Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
    Union(wsOrig.Columns("A:B"), wsOrig.Columns(c)).Copy Destination:=ws.Range("A1")
    On Error Resume Next
    ws.Name = Left(ws.Range("C1").Value, 31)
    On Error GoTo 0
  Next c
  Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

So now that there are others working on this I will move on.

 

[My Aswer Is This]

Well I came up with this script.

Sub copycols()
'Modified  10/29/2020  6:00:34 AM  EDT
Dim LC As Long, i As Long, ws As Worksheet
With ActiveSheet
    LC = .Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 3 To LC
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        .Columns(1).Copy Destination:=ws.Cells(1, 1)
        .Columns(2).Copy Destination:=ws.Cells(1, 2)
        .Columns(i).Copy Destination:=ws.Cells(1, 3)
            ws.Name = .Cells(1, i).Value
    Next i
End With
End Sub

 

[sharicn]

See if this does what you want. I have assumed the sheet with data as shown in post #3 is the active sheet when the code is run. If that assumption may be incorrect then please confirm the name of that sheet.

Test with a copy of your workbook.

Sub Create_Sheets()
  Dim LastCol As Long, c As Long
  Dim wsOrig As Worksheet, ws As Worksheet
 
  Set wsOrig = ActiveSheet
  LastCol = wsOrig.Cells(1, Columns.Count).End(xlToLeft).Column
  Application.ScreenUpdating = False
  For c = 3 To LastCol
    Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
    Union(wsOrig.Columns("A:B"), wsOrig.Columns(c)).Copy Destination:=ws.Range("A1")
    On Error Resume Next
    ws.Name = Left(ws.Range("C1").Value, 31)
    On Error GoTo 0
  Next c
  Application.ScreenUpdating = True
End Sub

This worked brilliantly, thanks so much!
Shari

 

[sharicn]

Well I came up with this script.

Sub copycols()
'Modified  10/29/2020  6:00:34 AM  EDT
Dim LC As Long, i As Long, ws As Worksheet
With ActiveSheet
    LC = .Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 3 To LC
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        .Columns(1).Copy Destination:=ws.Cells(1, 1)
        .Columns(2).Copy Destination:=ws.Cells(1, 2)
        .Columns(i).Copy Destination:=ws.Cells(1, 3)
            ws.Name = .Cells(1, i).Value
    Next i
End With
End Sub

This also worked brilliantly - I'm sorry that I can't mark two posts as solutions!
Shari

 

[Peter_SSs]

Glad that we could help. Thanks for the follow-up.

Just a note on possible slight differences in using the two codes. If any of the raffle item names contain ...

- characters that are not allowed as sheet names (eg. "Cake/Chocolates"), or
- more than 31 characters (eg. "Brand new yellow Ford Convertible")

.. then the post #6 code will error & stop processing further. In the same circumstance the post #4 code will still create all the sheets and copy the columns across.
For the case with illegal characters, my code will leave the sheet name with whatever default name Excel gives it when it is created. For long names my code will use the left 31 characters, unless that sheet name already exists in which case it would again use the default name. That is the reason for the two "On Error ..." lines in my code.

 

[sharicn]

Glad that we could help. Thanks for the follow-up.

Just a note on possible slight differences in using the two codes. If any of the raffle item names contain ...

- characters that are not allowed as sheet names (eg. "Cake/Chocolates"), or
- more than 31 characters (eg. "Brand new yellow Ford Convertible")

.. then the post #6 code will error & stop processing further. In the same circumstance the post #4 code will still create all the sheets and copy the columns across.
For the case with illegal characters, my code will leave the sheet name with whatever default name Excel gives it when it is created. For long names my code will use the left 31 characters, unless that sheet name already exists in which case it would again use the default name. That is the reason for the two "On Error ..." lines in my code.

Perfect! Thanks for the clarification.