Question

用户将选择他们想要分开的工作表的列范围

Sub CopyUnique()

    Dim NewCode As Range
    Set NewCode = Application.InputBox(prompt:="Select the column with the code numbers", Title:="New Event Selector", Type:=8)
    Dim s2 As Worksheet
    With NewCode
        For currentColumn = 1 To .Columns.Count Step 1
            Set s2 = Sheets.Add(After:=Sheets(Sheets.Count))
            s2.Name = "New.currentColumn"
            NewCode.Copy _
            Destination:=s2.Range("A1")
            s2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
            s2.Move
            ActiveWorkbook.SaveAs ("C:\Chatbot\Output\Wb.xlsx")
            ActiveWorkbook.Close True
         Next currentColumn

    End With


End Sub

我的输出仅创建一张工作表，而我希望为所选的每一列提供唯一的工作簿。

Answer 1

这将起作用。

现在它将一次仅复制一列，并且还将工作簿以不同的名称保存在同一路径中。我在姓名末尾添加了1,2,3 ....等。

Sub CopyUnique()

    Dim NewCode As Range
    Set NewCode = Application.InputBox(prompt:="Select the column with the code numbers", Title:="New Event Selector", Type:=8)
    Dim s2 As Worksheet
    With NewCode
        For currentcolumn = 1 To .Columns.Count Step 1
            Set s2 = Sheets.Add(After:=Sheets(Sheets.Count))
            s2.Name = "New.currentColumn"
            NewCode.Columns(currentcolumn).Copy _
            Destination:=s2.Range("A1")
            s2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
            s2.Move
            ActiveWorkbook.SaveAs ("C:\Chatbot\Output\Wb" & currentcolumn & ".xlsx")
            ActiveWorkbook.Close True
         Next currentcolumn

    End With


End Sub

您可以根据需要进行更改。

用户将输入列的范围，每列将保存在新的工作簿中

1 个答案: