Kopieren Sie Spaltendaten in ein neues Arbeitsblatt und durchlaufen Sie die Spalten

Question

Ich habe eine Excel-Tabelle mit über 60 Spalten. Jede Spalte enthält Daten aus einer SharePoint-Umfrage. Die Spaltenüberschriften sind die tatsächlichen Umfragefragen, die aus einer SharePoint-Datenverbindung importiert wurden. Ich versuche hier einige Dinge zu tun.

Zuerst möchte ich jede Spalte in ein neues Arbeitsblatt kopieren. (Der Grund dafür ist, dass ich die Daten in jeder Spalte zu einem PowerPivot-Datenmodell hinzufügen kann. PowerPivot erkennt das gesamte Arbeitsblatt als eine Tabelle, sodass ich nicht nur "Spalte A" zum Hinzufügen auswählen kann Zu dem Datenmodell fügt es automatisch die gesamte Tabelle mit allen 60 Spalten hinzu).

Da ich nicht zuerst manuell 60 neue Blätter hinzufügen möchte, möchte ich, dass der Code jede Spalte in ein neu erstelltes Arbeitsblatt kopiert. (Die Arbeitsblätter müssen nicht benannt werden, ich könnte das manuell tun, es sei denn jemand hat einen einfachen Weg, dies zu tun!)

Dann möchte ich den Code durch jede Spalte durchlaufen die Kopie durchführen und fügen Sie das neu erstellte Blatt ein.

Ich habe einige Beispiele für den Code hier für mehrere verwandte Themen gefunden, aber ich bin so neu in VBA, dass es mir schwer fällt, alles zusammen zu stellen. Vielen Dank für Ihre Zeit!

Ich habe folgendes versucht, die es tut kopieren Sie, aber ich bin nicht sicher, wie ein neues Blatt und eine Schleife durch die Spalten hinzufügen

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

du stattdessen tun sollten, bitte beachten Sie, dass es ist keine Fehlerbehandlung auf Ihre Bedürfnisse

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