Как я могу скопировать и вставить отфильтрованный диапазон в другую книгу?

Question

Когда я вставляю данные суммы, которые я скопировал из отфильтрованного диапазона через код VBA, я не получаю правильный результат.Как я могу скопировать и вставить правильный отфильтрованный диапазон в VBA?

Я пробовал так много способов, как видимые ячейки и изменение размера.

Dim Rangedata as Range, U as Range
'Table Range
Set Rangedata = D.Range("A1:C" & Range("A1").End(xlDown).Row)
Rangedata.AutoFilter Field:=2, Criteria1:=Log.Cells(8, 3) 
'Amount which i want to copy without Header
Set U = D.Range("C1:C" & Range("C1").End(xlDown).Row)
U.Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
U.copy

Есть почти 22 суммы, но я толькополучить 10 сумм.

Answer 1

Вам нужно будет добавить переменные для ссылки на две книги, но, надеюсь, этот пример сработает.

Sub CopyPasteFilteredRange()

Dim D As Worksheet
Dim Log As Worksheet
Dim PasteHere As Worksheet
Dim Rangedata As range, U As range
Dim Lastrow As Long 'Get Last Row
Set D = Worksheets("D")
Set Log = Worksheets("Log")
Set PasteHere = Worksheets("PasteHere") 'Added Sheet PasteHere as Example

    'Remove Filtered Criteria Before Filtering
    If ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If

    'Table Range
    Set Rangedata = D.range("A1:C" & range("A1").End(xlDown).Row)
    Rangedata.AutoFilter Field:=2, Criteria1:=Log.Cells(8, 3)
    'Amount which i want to copy without Header

    'If you have filtered above on Column B, but if there are blank cells in Col C .End(XlDown will stop at first blank value, so add lastRow to capture all used rows
    Lastrow = D.UsedRange.Rows(D.UsedRange.Rows.Count).Row
    Set U = D.range("C1:C" & Lastrow)

    'Set U to Visable Cells otherwise what you are .copying is still = D.range("C1:C" & range("C1").End(xlDown).Row)
    Set U = U.Offset(1, 0).SpecialCells(xlCellTypeVisible)

    U.Copy 'Don't have to Select U

    PasteHere.range("A1").PasteSpecial


End Sub