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

Copy Column Data to New Worksheet and Loop through Columns

我有一个 Excel 分布sheet 超过 60 列。每列包含来自 SharePoint 调查的数据。 headers 列是从 SharePoint 数据连接导入的实际调查问题。我想在这里做几件事。

首先,我想将每一列都复制到一个新作品中sheet.(我需要这样做的原因是我可以将数据添加到将每一列添加到 PowerPivot 数据模型。PowerPivot 将整个工作sheet 识别为一个 table,因此它不会让我 select 仅 "Column A" 添加到数据模型, 它会自动添加整个 table 的所有 60 列)。

因为我不想在此之前先手动添加 60 个新的 sheet,所以我希望代码能够将每一列复制到一个新创建的作品中sheet。 (作品sheet不需要命名,我可以手动命名,除非有人也有简单的方法!)

然后,我希望代码循环遍历每一列,执行复制并粘贴到新创建的 sheet。

我在这里找到了几个相关主题的一些代码示例,但我对 VBA 太陌生了,很难将它们放在一起。非常感谢大家的宝贵时间!

我已经尝试了以下确实会复制它的方法,但我不确定如何添加新的 sheet 并循环遍历列

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

你应该这样做,请注意,没有错误处理,适合你的需要

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