将列数据复制到新工作表并循环遍历列

Question

我有一个包含超过60列的Excel电子表格。每列包含来自SharePoint调查的数据。列标题是从SharePoint数据连接导入的实际调查问题。我试图在这里做几件事。

首先，我想将每一列复制到一个新的工作表。（我需要这样做的原因是我可以将每列中的数据添加到PowerPivot数据模型.PowerPivot识别将整个工作表作为一个表，因此不允许我只选择＆＃34; A列和＃34;添加到数据模型中，它会自动添加包含所有60列的整个表格。

由于我不希望在此之前先手动添加60张新表，因此我希望将每列复制到新创建的工作表中。 （工作表不需要命名，我可以手动完成，除非有人也有这么简单的方法！）

然后，我希望代码循环执行复制并粘贴到新创建的工作表的每一列。

我在这里找到了几个相关主题的代码示例，但我对VBA这么新，我很难把它们放在一起。非常感谢你的时间！

我已经尝试过将其复制过来的以下内容，但我不确定如何添加新工作表并循环遍历列

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

Answer 1

您应该这样做，请注意，没有错误处理，适合您的需求

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