Добрый день, коллеги. Необходимо разделить один лист по критериям с помощью VBA по отдельным листам, который в столбце K в документе. По номерам счетов. Так можно сделать? Помогите, пожалуйста.
Добрый день, коллеги. Необходимо разделить один лист по критериям с помощью VBA по отдельным листам, который в столбце K в документе. По номерам счетов. Так можно сделать? Помогите, пожалуйста.Nika4880
Sub Макрос1() Set dic = CreateObject("Scripting.Dictionary") arr = Sheets("data_2022-12-14_16-06-43").ListObjects("Таблица1").ListColumns("Номер выставленного нами счета, счет-фактуры, даты выставления").DataBodyRange Application.DisplayAlerts = False For n = 1 To UBound(arr) If Not dic.Exists(arr(n, 1)) Then dic.Add arr(n, 1), arr(n, 1) Sheets("data_2022-12-14_16-06-43").Copy Before:=Sheets(1) ActiveSheet.Name = Replace(arr(n, 1), ".", "_") With ActiveSheet.ListObjects([a7].ListObject.Name) .Range.AutoFilter Field:=11, Criteria1:="<>" & arr(n, 1), Operator:=xlOr .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete .Range.AutoFilter Field:=11 End With End If Next Application.DisplayAlerts = True End Sub
[/vba]
Попробуйте так: [vba]
Код
Sub Макрос1() Set dic = CreateObject("Scripting.Dictionary") arr = Sheets("data_2022-12-14_16-06-43").ListObjects("Таблица1").ListColumns("Номер выставленного нами счета, счет-фактуры, даты выставления").DataBodyRange Application.DisplayAlerts = False For n = 1 To UBound(arr) If Not dic.Exists(arr(n, 1)) Then dic.Add arr(n, 1), arr(n, 1) Sheets("data_2022-12-14_16-06-43").Copy Before:=Sheets(1) ActiveSheet.Name = Replace(arr(n, 1), ".", "_") With ActiveSheet.ListObjects([a7].ListObject.Name) .Range.AutoFilter Field:=11, Criteria1:="<>" & arr(n, 1), Operator:=xlOr .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete .Range.AutoFilter Field:=11 End With End If Next Application.DisplayAlerts = True End Sub