Excel VBA - поиск данных с помощью цикла и копирование выбранных строк на другой лист

Question

У меня проблема с копированием данных на другой лист. У меня есть дата со строковыми значениями, которые я хочу найти конкретное значение, которое я выбираю из выпадающего меню. Все соответствующие значения должны быть скопированы на другой лист.

Кажется, мой код просто не работает, я уже перебрал множество вещей, но не могу понять, в чем проблема.

Dim datasheet As Worksheet 'data copied from
Dim reportsheet As Worksheet 'data copied to
Dim abhaengigkeit As String
Dim finalrow As Integer
Dim i As Integer 'row counter

'sets vars
Set datasheet = Tabelle1
Set reportsheet = Tabelle44
abhaengigkeit = datasheet.Range("L3").Value


'goto datasheet and search and copy
datasheet.Select
finalrow = Cells(Rows.Count, 15).End(xlUp).Row

'loop to find records

For i = 2 To finalrow
    If Cells(i, 15) = abhaengigkeit Then
    ''Copy Soll''
        Range(Cells(i, 16), Cells(i, 23)).Copy      'copy collum 1 to 10
        reportsheet.Select 'goto reportsheet (Aenderungsfortpflanzung)
        Range("A150").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll 'paste 
under last entry
        datasheet.Select
    End If
Next i

В моей таблице данных (Tabelle1) находится раскрывающийся список и таблица данных. Отчетный лист - это мой целевой лист, куда я хочу скопировать совпадающие результаты.

Ячейка L3 - это выпадающее меню, мой цикл с данными должен проходить через столбец P и копировать все значения, указанные в следующих 8 столбцах ...

У вас есть идея или намек на то, что мне здесь не хватает?

Спасибо!

Answer 1

Это работает

Option Explicit
Public Sub test()

    Dim datasheet As Worksheet
    Dim reportsheet As Worksheet
    Dim abhaengigkeit As String
    Dim finalrow As Long
    Dim i As Long

    Set datasheet = ThisWorkbook.Worksheets("Tabelle1") '<== I have set this up as sheet names not code names
    Set reportsheet = ThisWorkbook.Worksheets("Tabelle44")
    abhaengigkeit = datasheet.Range("L3").Value

    With datasheet
        finalrow = .Cells(.Rows.Count, 15).End(xlUp).Row
        Dim unionRng As Range

        For i = 2 To finalrow
            If Cells(i, 15) = abhaengigkeit Then '<column 0
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, .Range(.Cells(i, 16), .Cells(i, 23))) ' 'P to W
                Else
                    Set unionRng = .Range(.Cells(i, 16), .Cells(i, 23))
                End If
            End If
        Next i

    End With

    If Not unionRng Is Nothing Then
       If IsEmpty(reportsheet.Range("A150").End(xlUp)) And reportsheet.Range("A150").End(xlUp).Row = 1 Then
            unionRng.Copy reportsheet.Range("A1")
        Else
            unionRng.Copy reportsheet.Range("A150").End(xlUp).Offset(1, 0)
        End If
    End If
End Sub