Copy entire columns to separate worksheets

exceldb

New Member
Joined
Apr 19, 2019
Messages
21
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
 
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.
 
Upvote 0

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
:confused:

What does this msgbox say, on the first time through the loop?
Code:
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
 
Upvote 0
That's all correct.
This shouldn't make any difference, but try
Code:
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?
 
Upvote 0
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.
 
Last edited:
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
Ok, how about
Code:
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
 
Upvote 0
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!
 
Upvote 0
You're welcome &thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

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