Copy Column Data to New Worksheet and Loop through Columns

Question

I have an Excel spreadsheet with over 60 columns. Each column contains data from a SharePoint survey. The column headers are the actual survey questions that have been imported from a SharePoint data connection. I'm trying to do several things here.

First, I want to copy each column to a new worksheet. (The reason I need to do this is so that I can add the data in each column to a PowerPivot Data Model. PowerPivot recognizes the entire worksheet as one table, so it won't let me select only "Column A" to add to the Data Model, it automatically adds the entire table with all 60 columns).

Since I don't want to manually add 60 new sheets first before this, I'd like the code to copy each column to a newly created worksheet. (the worksheets don't need to be named, I could do that manually, unless someone has an easy way to do this as well!)

Then, I'd like the code to loop through each column performing the copy and paste to the newly created sheet.

I've found some examples of the code here for several related topics, but I'm so new to VBA that I'm having a hard time putting it all together. Thank you all so much for your time!

I've tried the following which does copy it over, but I'm not sure how to add a new sheet and loop through the columns

Sub CopyColumnToNewSheet()

    Dim lastRow As Long
    lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Sheet2").Range("A1:A" & lastRow).Value = Sheets("Sheet1").Range("A1:A" & lastRow).Value

End Sub

Welcome to S.O! Have you tried anything? If so, please, provide the code, take a look to the tour and how to ask. Friendly reminder: StackOverflow is not a "we code for you" service provider. Introduction to VBA — Sgdva
@SgdvaSub CopyColumnToNewSheet() Dim lastRow As Long lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row Sheets("Sheet2").Range("A1:A" & lastRow).Value = Sheets("Sheet1").Range("A1:A" & lastRow).Value End Sub — James Straker

Sgdva Sgdva · Accepted Answer · 2016-08-30T19:56:37

You should do this instead, please note, there is no error handling, suit to your needs

Sub CopyColumnToNewSheet()
    Const MySourcheSheetName = "Sheet1"
    Dim CounterColumn As Long
    For CounterColumn = 1 To Sheets(MySourcheSheetName).Cells.SpecialCells(xlCellTypeLastCell).Column
    Sheets.Add
    ActiveSheet.Name = Sheets(MySourcheSheetName).Cells(1, CounterColumn).Value 'ideally the title is unique and it's in the first row of each column
    Sheets(MySourcheSheetName).Columns(CounterColumn).Copy Destination:=ActiveSheet.Columns(1)
    Next CounterColumn
End Sub

Copy Column Data to New Worksheet and Loop through Columns

1 Answers