Microsoft Excel

Herbers Excel/VBA-Archiv

Tabelle aktualisieren VBA

Betrifft: Tabelle aktualisieren VBA von: Pascal
Geschrieben am: 05.08.2020 12:00:31

Hallo zusammen,

ich möchte gerne eine Tabelle mit Hilfe von VBA aktualisieren.
Hierbei soll aus dem Worksheet "Katalog" aus den Spalten Q298:Q384 Werte im Worksheet "LID" in der Spalte F gesucht werden. Anschließend sollen die daneben stehenden Werte (also aus den Spalten C, D & E ) aus dem Worksheet "LID" in das Worksheet "Katalog" übertragen werden.
Beispiel der Wert aus Q298 wird im Worksheet LID in Zelle F120 gefunden. Dann sollen die Werte aus C120 , D120 & E120 in das Worksheet Katalog in die Zellen N298, O298 & P298 übertragen werden.

With Worksheets("Katalog")
Set raBereich = .Range("Q298:Q384").SpecialCells(xlCellTypeVisible)
For Each raZelle In raBereich
ThisWorkbook.Sheets("LID").Activate
With Worksheets("LID")
Set raFund = .Columns("F").Find(What:=raZelle, LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
If raZielbereich Is Nothing Then
Set raZielbereich = raFund
Else
Set raZielbereich = Union(raZielbereich, raFund)
End If
End If
End With
Next raZelle
If Not raZielbereich Is Nothing Then
raFund.Offset(, -1).Copy Destination:=ThisWorkbook.Worksheets("Katalog").raZelle.Offset(, -1).PasteSpecial
raFund.Offset(, -2).Copy Destination:=ThisWorkbook.Worksheets("Katalog").raZelle.Offset(, -2).PasteSpecial
raFund.Offset(, -3).Copy Destination:=ThisWorkbook.Worksheets("Katalog").raZelle.Offset(, -3).PasteSpecial
End If
End With

Set raBereich = Nothing: Set raFund = Nothing: Set raZielbereich = Nothing
End Sub

hierbei erhalte ich eine Laufzeitfehler 438.
Vielen Dank für die Hilfe im Voraus und einen lieben Gruß

Betrifft: AW: Tabelle aktualisieren VBA
von: Werner
Geschrieben am: 05.08.2020 12:41:01

Hallo,

teste mal:
Public Sub aaa()
Dim raBereich As Range, raZelle As Range, raFund As Range

Application.ScreenUpdating = False

With Worksheets("Katalog")
    Set raBereich = .Range("Q298:Q384").SpecialCells(xlCellTypeVisible)
    For Each raZelle In raBereich
        With Worksheets("LID")
            Set raFund = .Columns("F").Find(What:=raZelle, LookIn:=xlValues, lookat:=xlWhole)
            If Not raFund Is Nothing Then
                raFund.Offset(, -3).Resize(, 3).Copy
                raZelle.Offset(, -3).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If
        End With
    Next raZelle
End With

Set raBereich = Nothing: Set raFund = Nothing
End Sub
Gruß Werner

Betrifft: AW: Tabelle aktualisieren VBA
von: Pascal
Geschrieben am: 05.08.2020 14:09:57

Hallo Werner,

Code Funktioniert super!
Vielen Dank und einen lieben Gruß

Betrifft: Gerne u. Danke für die Rückmeldung. o.w.T.
von: Werner
Geschrieben am: 05.08.2020 14:56:18



Beiträge aus dem Excel-Forum zum Thema "Tabelle aktualisieren VBA"