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

 

[Fluff]

Hi & welcome to MrExcel
How about

Sub exceldb()
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Range("A1").CurrentRegion.Value2
   For i = 2 To UBound(Ary, 2)
      Sheets.Add(, Sheets(Sheets.Count)).Name = Ary(1, i)
      Range("A1").Resize(UBound(Ary), 2).Value = Application.Index(Ary, Evaluate("row(1:" & UBound(Ary) & ")"), Array(1, i))
   Next i
End Sub

 

[exceldb]

This worked out perfect - I need to learn how to do this!!!!!!

thank you a ton!

 

[exceldb]

Now just to be curious, what if I would like to transfer the first one and only some columns - Would there be a way to specify which columns to copy along with column A?
thanks!

 

[Fluff]

Yes
Will it always be the same columns, or do you need to specify them each time?

 

[exceldb]

Yes
Will it always be the same columns, or do you need to specify them each time?

Great question. I should have thought of that when posting but now that I think about it.
Though now that I am thinking about it.

1. One scenario would be hard coded to the same columns by column number much like vlookup works ( so column 2, 3 & 5 & 7) along with Column A.
2. Another would be hard coded by header, copying the entire column along with Column A
3. If you really wanted to get fancy, search through the column, find a special character, if found, go ahead and copy that entire column along with Column A.

 

[Fluff]

Using column numbers

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)
      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]

Hi Fluff,

This latest solution copied the first array (1,3,5,7), named the sheets by the header of the column, but it did not copy over any data.

 

[Fluff]

Not sure why, as it works for me.
Are the new sheets completely blank?

 

[exceldb]

Yes, empty.
For learning purposes, could you add comments on each line so I know the expected behavior or is that too much to ask?

Thanks!