使用for循环移动列

我有一个包含多行的主电子表格，我想将每列移动到不同的电子表格从第四张到最后一张。

当我尝试运行这个时出现编译错误。 主标签有一个可变数量的列，称为时间，Room1，Room2，Room3 ….所以，我已经为每个房间创build了一个单独的选项卡。 现在，我要遍历主工作表上的每个列，并将每个相关列移到相应的选项卡中。 有没有更好的方法来做到这一点，而不是for循环内的for循环？

Sub MoveData2() Dim S As Integer Dim LastCol As Long Dim F As Long Dim NameTest As String, NameStr As String Dim LastRow As Long Sheets("Master").Activate Range("B4", "B" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets("Room1").Activate Range("B5").Select ActiveSheet.Paste Sheets("Master").Activate LastCol = Sheets("Master").Cells(4, Columns.Count).End(xlToLeft).Column For F = 3 To LastCol LastRow = Sheets("Master").Cells(Rows.Count, F).End(xlUp).Row Sheets("Master").Range(Cells(4, F), Cells(LastRow, F)).Copy 'This next part checks to see if worksheet exists and creates if it doesn't exist NameStr = "Room" & F NameTest = Worksheets(NameStr).Name If Err.Number = 0 Then Else Err.Clear Worksheets.Add.Name = NameStr End If 'End of check if it exists and creates it code Sheets("Room" & F - 1).Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Next F End Sub 

Answer 1

 Sub MoveData2() Dim S As Integer Dim LastCol As LongSub MoveData2() Dim S As Integer Dim LastCol As Long Dim F As Long Dim NameTest As String, NameStr As String Dim LastRow As Long On Error Resume Next LastCol = Sheets("Master").Cells(1, Columns.Count).End(xlToLeft).Column For F = 4 To LastCol LastRow = Sheets("Master").Cells(Rows.Count, F).End(xlUp).Row Sheets("Master").Range(Cells(1, F), Cells(LastRow, F)).Copy 'This next part checks to see if worksheet exists and creates if it doesn't exist NameStr = "Sheet" & F NameTest = Worksheets(NameStr).Name If Err.Number = 0 Then Else Err.Clear Worksheets.Add.Name = NameStr End If 'End of check if it exists and creates it code Sheets("Sheet" & F).Range("B4").PasteSpecial Next F End Sub