скопировать все строки из набора данных для каждого уникального значения в одном столбце на новые листы в vba

Question

Проблема

1. У меня есть лист, в котором сначала я должен отфильтровать последний столбец.

2. Для каждого уникального значения, присутствующего в последнем столбец, я должен скопировать данные из первого столбца в последний-1 столбец

3. Затем мне нужно добавить новый лист и нужно вставить эти данные в новый лист.

4. Я повторяю один и тот же процесс 3 для каждого уникального значения, представленного в последнем столбце. Как и в последнем столбце языка. поэтому сначала отсортируйте этот столбец. затем скопируйте и вставьте данные для каждого языка в новые листы.

Answer 1

Sub LoopThroughAllItemsInFilters()

Range("G2", Range("G" & Cells(Rows.Count, 1).End(xlUp).Row)).Select
Selection.Copy

Columns("L").Select
ActiveSheet.Paste
ActiveSheet.Range("$L$1:$L$10000").RemoveDuplicates Columns:=1, Header:=xlYes

Dim ArrayDictionaryofItems As Object, Items As Variant, i As Long, Item As Variant

Set ArrayDictionaryofItems = CreateObject("Scripting.Dictionary")

With ActiveSheet

'show autofilter if not already shown on all rows

If Not .AutoFilterMode Then .UsedRange.AutoFilter
If .Cells.AutoFilter Then .Cells.AutoFilter

'Create list of unique items in column G that get filled into ArrayDictionaryofItems
Dim annoying As Double

If Range("G3").Value <> "" Then
annoying = 2
Items = Range(.Range("L2"), .Cells(Rows.Count, "L").End(xlUp))

'Fills ArrayDictionaryofItems to the UBOUND (max) count of unique items in column L.

For i = 1 To UBound(Items, 1)
ArrayDictionaryofItems(Items(i, 1)) = 1
Next

Else

Item = Range("G2").Value
annoying = 1
End If

'Filter multiple items if annoying is set to equal 2 because G3 is blank
If annoying = 2 Then

For i = 1 To UBound(Items, 1)
Sheets.Add After:=Sheets(i)
Next i

Sheets("DEFAULTERS").Select

Dim x As Double
x = 2

For Each Item In ArrayDictionaryofItems.keys
erow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
'autofilter on column b with this driver
.UsedRange.AutoFilter field:=7, Criteria1:=Item

Columns("A:G").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy

Sheets(x).Select
Columns("A:G").Select
ActiveSheet.Paste
Sheets("DEFAULTERS").Select

x = x + 1
Next Item
GoTo LINE99:
End If

'Filter a single item in column since G3 is blank and there is only one item in column G to filter
If annoying = 1 Then

Sheets.Add After:=ActiveSheet
Sheets("DEFAULTERS").Select

Item = Range("G2").Value
.UsedRange.AutoFilter field:=7, Criteria1:=Item
End If

Columns("A:G").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy

Sheets(2).Select
Columns("A:G").Select
ActiveSheet.Paste
Sheets("DEFAULTERS").Select

End With

LINE99:
With ActiveSheet
If .AutoFilterMode Then .UsedRange.AutoFilter
End With

End Sub