Вставка автофильтрованного ряда в другой лист - PullRequest
0 голосов
/ 08 февраля 2020

Я пытаюсь автоматически фильтровать (в столбце A ЛИСТА 1) активную ячейку в ЛИСТЕ 2. Затем у меня есть IF Statement , который подсчитывает количество видимых строк, и если это больше 1 (исключая заголовок) , тогда я хотел бы вставить новую строку в SHEET 3 и вырезать и вставить значения строки с автоматической фильтрацией в SHEET 1 в новую строку в SHEET 3.

Затем я очищаю Автофильтр в SHEET 1, и вставляю новую строку в SHEET 1 , вырезать и вставлять значения строки активной ячейки из SHEET 2 в новую строку в SHEET 1.

IF нет результатов автоматического фильтра в SHEET 1, , затем ELSE STATEMENT очищает автоматический фильтр в SHEET 1, вставляет новую строку в SHEET 1 , вырезать и вставить значения строки активной ячейки из SHEET 2 в новую строку в SHEET 1.

* 10 40 * В настоящее время я не могу заставить свой код работать, если автофильтр приводит к SHEET 2 в любых строках> Строка 2. Вот мой текущий код, который я прокомментировал, чтобы помочь с навигацией :
Sub Autofilter_Macro()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet

Set sh1 = Sheet1
Set sh2 = Sheet2
Set sh3 = Sheet3

Dim rng As Range

Dim AC As Integer
AC = ActiveCell.Row

sh1.AutoFilterMode = False 'Clears any AutoFilters from Sheet1

sh1.Range("A:A").AutoFilter Field:=1, Criteria1:=ActiveCell.Value 'AutoFilters SHEET 1 column "A" based off the ActiveCell Row in SHEET 2

Set rng = sh1.UsedRange.SpecialCells(xlCellTypeVisible) 'Sets rng to visible cells

    If (rng.Rows.Count > 1) Then 'Counts the # of visible rows

        sh3.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 3

        sh3.Range("A2:CK2").Value = rng.Offset(rowOffSet:=1).Value 'Sets the new empty row's values in SHEET 3 = the values of the Autofiltered row in SHEET 1

        sh1.ShowallData 'Clears any Autofilters from SHEET 1

        sh1.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 1

        sh1.Range("A2:CK2").Value = sh2.Range(Cells(AC, 1), Cells(AC, 89)).Value 'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2

        MsgBox "Replaced Main Database" 'MsgBox indicating what has executed

    Else

        sh1.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 1

        sh1.Range("A2:CK2").Value = sh2.Range(Cells(AC, 1), Cells(AC, 89)).Value 'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2

         MsgBox "New Entry into Main Database"

    End If

sh1.ShowallData 'Clears any Auotfilters from SHEET 1

End Sub

...