复制和粘贴具有相同工作表名称的值

Question

我有一个 VBA 程序需要根据它们的工作表名称来复制和粘贴值。
工作表名称将在特定列（Bin 列）中提取，并将作为添加工作表的名称基础。 有没有办法可以复制这些值并根据它们的 Bin 值粘贴它们？

例如，我的 bin 值是QWE, RTY, UIO ，它们在原始工作表上重复，这就是我创建列表的原因。 然后在创建列表后，Sub CreateSheets()将创建工作表QWE 、工作表RTY和工作表UIO 。 我的问题是如何根据工作表名称和设置编号粘贴值。

样本数据表

这是我提取并创建垃圾箱列表（删除重复值）的代码

 Sub BIN_Values_List() Dim rSelection As Range Dim ws As Worksheet Range("F3:F" & Range("F" & Rows.Count).End(xlUp).Row).Select Set rSelection = Selection Set ws = Worksheets.Add ws.Name = "BIN LIST" rSelection.Copy With ws.Range("A1").PasteSpecial xlPasteValues.PasteSpecial xlPasteValues End With ws.UsedRange.RemoveDuplicates Columns:=Array(1), Header:=xlGuess On Error Resume Next ws.UsedRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp On Error GoTo 0 ws.Columns("A").AutoFit Application.CutCopyMode = False End Sub

创建列表后，此代码将根据 bin 列表以及结果模板创建和重命名工作表。

 Sub CreateSheets() lastcell = ThisWorkbook.Worksheets("BIN LIST").Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lastcell With ThisWorkbook newname = ThisWorkbook.Worksheets("BIN LIST").Cells(i, 1).Value.Sheets.Add after:=.Sheets(.Sheets.Count) ActiveSheet.Name = newname Sheets("RESULT TEMPLATE").Range("A1:E205").Copy ActiveSheet.Paste End With Next ThisWorkbook.Worksheets("SHEET1").Activate ThisWorkbook.Worksheets("SHEET1").Cells(1, 1).Select End Sub

Answer 1

这似乎是您要编码的方案：-

“遍历工作表“BIN LIST”中的所有行，并将每个项目复制到名称由“BIN”列指示的工作表中。如果工作表不存在，请将其添加到工作簿中。

您已经有一个调用每一行的循环，但您需要重新调整它的用途以执行所需的操作，即复制数据并粘贴到另一张工作表。 使用下面的 function 获取工作表。 如果工作表不存在，它将以正确的名称创建工作表。 我将其设为Private是因为它可能会被您的主程序调用，这可能是Public 。

Private Function CurrentSheet(ByVal SheetName As String) As Worksheet

    Dim Fun         As Worksheet            ' function return object
    Dim AppStatus   As Boolean              ' current setting of ScreenUpdating
    Dim Ws          As Worksheet            ' ActiveSheet

    With ThisWorkbook
        On Error Resume Next
        Set Fun = Worksheets(SheetName)
        If Err Then
            ' the error that occured results from the sheet not being available
            With Application
                AppStatus = .ScreenUpdating ' remember current setting
                .ScreenUpdating = False     ' disable updating
            End With
            Set Ws = ActiveSheet            ' remember the current ActiveSheet
            
            ' this will create a new sheet and activate it
            Set Fun = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            Fun.Name = SheetName
            
            ' return the status to what it was
            Ws.Activate
            Application.ScreenUpdating = AppStatus
        End If
    End With
    Set CurrentSheet = Fun
End Function

而且，更重要的是，您绝对必须避免激活工作表和选择任何内容。 您可以读取和写入任何工作表，无论它是活动的还是可见的。 您应该努力保持在用户启动宏时处于活动状态的工作表处于活动状态。

上面的 function 将从您的循环中调用，并从 BIN LIST 中获取它需要的参数（工作表名称）。 但是为了测试的目的，你可以使用这个小程序，就像我一样。

Sub Test_CurrentSheet()

    Dim Ws      As Worksheet
    
    Set Ws = CurrentSheet("QWE")
    Debug.Print Ws.Name
End Sub