Пользователь введет диапазон столбцов, и каждый столбец будет сохранен в новой книге.

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

Вы можете изменить в соответствии с вашими потребностями.