Copy entire columns to separate worksheets

[exceldb]

Hi Everyone,

I am a newbie to this forum, though not necessarily new to the rules.
I have a very simple task to complete, yet no matter how many youtube videos I watched and how many different forums and pages I have read, none of them are this simple.

I did see a function called entirecolumncopy in one vba script, so I am hoping it can be done.

I basically have a master spreadsheet and I want to be able to copy the first column and subsequent columns to separate worksheets.
Now, I do not want to create the headers first, just copy something based on a location or department, I want a full copy of columns.

The end result being worksheets that contain the following

Sheet1 = Column A + Column B
Sheet2 = Column A + Column C
Sheet3 = Column A + Column D
.....
Column A of course being the unique identifier, in another words I want the sheets to act like a relational database where the primary key is always following the data.

Also, after reading a few threads, I want to add different items I see people ask for when trying to help.

1. The original name of the master spreadsheet should not matter
2. The vba should create as many sheets as there are many columns - so if 25 columns, then 25 sheets and if tomorrow I add a 26th, it will do that.
3. The names of the sheets should simply be the header for the second column ( In other words, if the header for column B in Sheet2 was location, the sheet should be "location"
4. The master spreadsheet should not be touched as it could be used for vlookups and other functions.

Last but not least, does anyone recommend a really good book for excel and vba - from beginner to advanced. There are a ton and I figured I would ask here.

Thank you in advance for all your help!
Tony

 

[exceldb]

Ok, that rules out a couple of possible problems.
If you step through the code using F8, after it has added a new sheet, is that sheet the active sheet?

Yes. I stepped through it and each sheet when created becomes the active sheet.
After the third one, it then steps into the end sub and it stops looping.

 

[Fluff]

What does this msgbox say, on the first time through the loop?

Sub exceldb()
   Dim Ary As Variant, ColAry As Variant
   Dim i As Long
   
   ColAry = Array(Array(1, 3, 5, 7), Array(1, 2, 4, 5, 6), Array(1, 8, 9, 10))
   Ary = Range("A1").CurrentRegion.Value2
   For i = 2 To UBound(ColAry(UBound(ColAry))) + 1
      Sheets.Add(, Sheets(Sheets.Count)).Name = Ary(1, i)
      MsgBox UBound(ColAry(i - 2)) & vbLf & ColAry(i - 2)(1)
      Range("A1").Resize(UBound(Ary), UBound(ColAry(i - 2)) + 1).Value = Application.Index(Ary, Evaluate("row(1:" & UBound(Ary) & ")"), Array(ColAry(i - 2)))
   Next i
End Sub

 

[exceldb]

3/3 = 3 on top and 3 below...
4/2
3/8

 

[Fluff]

That's all correct.
This shouldn't make any difference, but try

Sub exceldb()
   Dim Ary As Variant, ColAry As Variant
   Dim i As Long
   
   ColAry = Array(Array(1, 3, 5, 7), Array(1, 2, 4, 5, 6), Array(1, 8, 9, 10))
   Ary = Range("A1").CurrentRegion.Value2
   For i = 2 To UBound(ColAry(UBound(ColAry))) + 1
      Sheets.Add(, Sheets(Sheets.Count)).Name = Ary(1, i)
      Sheets(Ary(1, i)).Range("A1").Resize(UBound(Ary), UBound(ColAry(i - 2)) + 1).Value = Application.Index(Ary, Evaluate("row(1:" & UBound(Ary) & ")"), Array(ColAry(i - 2)))
   Next i
End Sub

Also do you have any merged cells?

 

[exceldb]

Ok hang tight as this actually acted different but I need to map it out for you. Give me 5.

Ok have to start all over, as I did not realize the previous code was actually messing with the data in the working sheet.

 

[exceldb]

Ok here is the result with a clean sheet.
It creates three sheets, they are named after the column headers for B,C,D instead of the column header of the column it initially pulled.
The data does come over but for some reason format of data is lost. Dates show up as long numbers.
I am going to try and keep it simple where it only pulls two columns and see what happens.

 

[exceldb]

Using the code below:

Sub exceldb()
Dim Ary As Variant, ColAry As Variant
Dim i As Long

ColAry = Array(Array(1, 17), Array(1, 18), Array(1, 22), Array(1, 24), Array(1, 28), Array(1, 29), Array(1, 32), Array(1, 22), Array(1, 33), Array(1, 34), Array(1, 35))
Ary = Range("A1").CurrentRegion.Value2
For i = 2 To UBound(ColAry(UBound(ColAry))) + 1
Sheets.Add(, Sheets(Sheets.Count)).Name = Ary(1, i)
Sheets(Ary(1, i)).Range("A1").Resize(UBound(Ary), UBound(ColAry(i - 2)) + 1).Value = Application.Index(Ary, Evaluate("row(1:" & UBound(Ary) & ")"), Array(ColAry(i - 2)))
Next i
End Sub

The results are the following:

1. Sheet is not named by the header in Column position 17, instead by Column position 2 (B Column)
2. It only creates one sheet and no other sheets are created.
3. Data does come over, so it does grab column 17 data and places it into Column B of the newly created sheet.

 

[Fluff]

Ok, how about

Sub exceldb2()
   Dim Ary As Variant, ColAry As Variant
   Dim i As Long
   
   ColAry = Array(Array(1, 17), Array(1, 18), Array(1, 22), Array(1, 24), Array(1, 28), Array(1, 29), Array(1, 32), Array(1, 22), Array(1, 33), Array(1, 34), Array(1, 35))
   Ary = Range("A1").CurrentRegion.Value2
   For i = 2 To UBound(ColAry) + 1
      Sheets.Add(, Sheets(Sheets.Count)).Name = Ary(1, ColAry(i - 2)(1))
      Sheets(Ary(1, ColAry(i - 2)(1))).Range("A1").Resize(UBound(Ary), UBound(ColAry(i - 2)) + 1).Value = Application.Index(Ary, Evaluate("row(1:" & UBound(Ary) & ")"), Array(ColAry(i - 2)))
   Next i
End Sub

 

[exceldb]

That is exactly what we need it - It threw an error in the same spot twice so i reviewed the code and saw 1,22 repeated and that is where the error triggered. Removed the duplicated 1,22 and it worked perfect.
This is absolutely awesome!
Thank you for all your help fluff!

 

[Fluff]

You're welcome &thanks for the feedback