Question

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

当我尝试运行它时，我收到编译错误。主选项卡有一个可变数量的列，分别称为Time，Room1，Room2，Room3，....，所以我为每个房间创建了一个单独的选项卡。现在，我想遍历主工作表上的每一列，并将每个相关列移动到它的相应选项卡。有没有更好的方法来执行此操作而不是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

使用for循环移动列

1 个答案: