用于复制和粘贴工作簿中多个工作表上的最后一列数据的VBA脚本

Question

我需要一个脚本，采取工作簿中的最后一列数据，并复制和粘贴该列中的数据直接向右。我的问题是，我需要对工作簿中的多个特定工作表执行此操作，因此我尝试使用循环，但我找不到使其工作的代码。任何帮助都是非常感谢的。

Sub CopyPaste()

Dim sArray
Dim lc As Long

Set sArray = Sheets(Array("sht3", "sht5", "sht7", "sht9", "sht11", "sht13", "sht15", "sht17" _
, "sht19", "sht21", "sht23", "sht25", "sht27", "sht29"))

For Each Sheet In sArray

lc = Cells(1, Columns.Count).End(xlToLeft).Column
Columns(lc).Copy
Cells(1, lc + 1).PasteSpecial Paste:=xlPasteAll

Next

End Sub

Answer 1

如果我理解你的问题，这应该可以解决它：

Option Explicit
Sub CopyPaste()

    Dim ws As Worksheet
    Dim lc As Integer
    Dim sArray As Variant

    Set sArray = Sheets(Array("sht3", "sht5", "sht7", "sht9", "sht11", "sht13", "sht15", "sht17" _
                        , "sht19", "sht21", "sht23", "sht25", "sht27", "sht29"))

    For Each ws In sArray
        With ws
            lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
            .Cells(1, lc).EntireColumn.Copy .Cells(1, lc + 1)
        End With
    Next ws

End Sub

Answer 2

您只需在循环中添加工作表引用，以便引用正确的工作表。(否则活动工作表将被引用，并且这在您的代码中不会改变。)

Sub CopyPaste()

Dim sArray
Dim lc As Long

Set sArray = Sheets(Array("sht3", "sht5", "sht7", "sht9", "sht11", "sht13", "sht15", "sht17" _
                    , "sht19", "sht21", "sht23", "sht25", "sht27", "sht29"))

For Each Sheet In sArray
    lc = Sheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Sheet.Columns(lc).Copy
    Sheet.Cells(1, lc + 1).PasteSpecial Paste:=xlPasteAll
Next

End Sub

Answer 3

下面我提供了两种循环遍历特定工作表的替代方法，以帮助您入门：

Dim sht As Worksheet
For Each sht In ThisWorkbook.Worksheets
    If sht.Name = "Something" Or sht.Name = "Something else" Then 'and so on and so forth...
        'do something
    End If
Next sht

或

Dim shtCollection As New Collection
Dim sht As Worksheet
With shtCollection
    .Add ThisWorkbook.Worksheets("Something")
    .Add ThisWorkbook.Worksheets("Something else")
    'and so on and so forth...
End With
For Each sht In shtCollection
    'do something
Next sht