Question

逗人，我想在下面的代码中添加以下代码：

从“结果”选项卡复制范围并将其粘贴到每个新创建的工作表。它应该复制到由下面的宏填充的同一列。

我认为我们需要在某处添加此代码：

Routes

它还应检查此列是否有重复项。

你能帮忙吗？

初始代码如下：

Worksheets("Results").Range("A1:A65").Copy Destination:=ActiveSheet.Range("a50:a150") ???

谢谢，

Answer 1

此代码会将结果中的数据复制到现有工作表中，然后创建四个新工作表并将数据粘贴到其中：

Sub PopulateSheets()

    Dim wrkSht As Worksheet
    Dim SheetCtr As Long, x As Long

    'First go through each sheet in the workbook.
    'If you want other sheets apart from 'Results' to be ignored just add them to the Case.
    'e.g. Case "Results", "Sheet1" will ignore Results & Sheet1.
    For Each wrkSht In ThisWorkbook.Worksheets
        Select Case wrkSht.Name
            Case "Results"
                'Do nothing - we're copying from this sheet.
            Case Else
                'Copy from Results to the other worksheet.
                With ThisWorkbook.Worksheets("Results")
                    .Range("A1:A65").Copy Destination:=wrkSht.Range("A50")
                End With
        End Select
    Next wrkSht

    'Creates 4 sheets, copies the data over and moves the sheet to the end.
    SheetCtr = 4
    With ThisWorkbook
        For x = 1 To SheetCtr
            Set wrkSht = ThisWorkbook.Worksheets.Add
            .Worksheets("Results").Range("A1:A65").Copy Destination:=wrkSht.Range("A50")
            wrkSht.Move After:=Sheets(.Sheets.Count)
        Next x
    End With

End Sub

如果您只是想在添加新工作表时复制数据 -
在普通模块中添加以下代码。该过程引用工作表并将结果表中的数据复制到该工作表并删除任何重复项。

Public Sub CopyToNewSheet(sht As Worksheet)

    With sht
        ThisWorkbook.Worksheets("Results").Range("A1:A65").Copy Destination:=.Range("A50")
        .Range("A50:A114").RemoveDuplicates Columns:=1, Header:=xlNo
    End With

End Sub

在ThisWorkbook模块中添加以下代码。这将检查您是否正在添加工作表而不是图表工作表或任何其他类型，并将工作表引用传递给CopyToNewSheet过程：

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    If Sh.Type = xlWorksheet Then
        CopyToNewSheet Sh
    End If
End Sub

复制范围并检查重复项

1 个答案: