Codemodifizierung

Hallo liebe Excel-Gemeinde,
ich habe einen funktionierenden VBACode, mit dem ich nach ArtikelNr filtere.

Sub Autofilter()
'Blattschutz aufheben
    Tabelle1.Unprotect
Tabelle1.Range("B11").Autofilter 3, Tabelle1.Range("D10").Value                             'nach ArtikelNr filtern
Tabelle1.Range("D10").ClearContents
'Blattschutz aufheben
  Tabelle1.Protect
End Sub

Den gefundenen ArtikelNr, samt den Daten in der Zeile, möchte ich in eine andere Tabelle (Buchung) übertragen.
An der Stelle -Selection.Delete Shift:=xlUp- scheitere ich und bekomme Fehlermeldung: Zellen in einem gefilternen Bereich oder in einer gefilternen Tabelle
können nicht verschoben werden.

Sub Datenbankzeile_to_Formular()
     Dim rng As Range
     Dim acr As Single
     Dim cpy_rng As Range, to_rng As Range
     Worksheets("Lagerbestand").Unprotect
     acr = ActiveCell.Row
     Set cpy_rng = Range(Cells(acr, "B"), Cells(acr, "L"))
     lz_B = Sheets("Buchung").Cells(Rows.Count, "B").End(xlUp).Row
     Set to_rng = Sheets("Buchung").Cells(lz_B + 1, "B")
     Worksheets("Buchung").Unprotect
     cpy_rng.Cut to_rng                                                                                  'ausschneiden
     Selection.Delete Shift:=xlUp                                                                     'markierte Zeile löschen
     Worksheets("Lagerbestand").Protect
     Sheets("Buchung").Activate
     Buchung.Show 0
     Worksheets("Buchung").Protect
 End Sub

Kann mir bitte jemand helfen dieses Problem zu lösen?
Vielen Dank im Voraus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Datenbankzeile_to_Formular() Dim rng As Range Dim acr As Single Dim cpy_rng As Range, to_rng As Range Worksheets("Lagerbestand").Unprotect acr = ActiveCell.Row Set cpy_rng = Range(Cells(acr, "B"), Cells(acr, "L")) lz_B = Sheets("Buchung").Cells(Rows.Count, "B").End(xlUp).Row Set to_rng = Sheets("Buchung").Cells(lz_B + 1, "B") Worksheets("Buchung").Unprotect cpy_rng.Copy to_rng 'ausschneiden cpy_rng.EntireRow.Delete 'markierte Zeile löschen Worksheets("Lagerbestand").Protect Sheets("Buchung").Activate Buchung.Show 0 Worksheets("Buchung").Protect End Sub

Sub Autofilter() 'Blattschutz aufheben Tabelle1.Unprotect Tabelle1.Range("B11").Autofilter 3, Tabelle1.Range("D10").Value 'nach ArtikelNr filtern Tabelle1.Range("D10").ClearContents 'Blattschutz aufheben Tabelle1.Protect End Sub

Sub Unit() With Tabelle1 .Unprotect With .UsedRange.Columns(.UsedRange.Columns.Count + 1) .FormulaR1C1 = "=IF(OR(RC4=R10C4,RC5=R10C5,ROW()11),"""",1)" .Formula = .Value End With With .UsedRange.Columns(.UsedRange.Columns.Count) If WorksheetFunction.CountA(.Cells) Then .SpecialCells(xlCellTypeConstants).EntireRow.Hidden = True .Clear End If End With .Protect End With End Sub

Hallo Dieter,
wenn die beide Information in 2 verschiedenen Spalten vorliegen, gibt es keine Lösung, weil 2 Filter sich immer "und" ergänzen.
Man kann eine temporäre Hilfespalte einführen, wo Nummer und Bezeichnung zusammengesetzt werden und ein Filter "enthalt" Inhalt von D10.
Andere Möglichkeit: die Liste als Tabelle umwandeln (sog. intelligente Tabelle: Menü "Einfügen", "Tabelle") und mit einer Abfrage* filtern: Menü "Daten", "aus Tabelle", dort eine benutzerdefinierte Spalte mit Verkettung Nummer und Bezeichnung, Filter "enthält" und abschliessend Spalte entfernen. Dann "Schliessen & laden".
Damit wird die temporäre Hilfespalte erzeugt, gefiltert und anschliessend entsorgt und das Ergebnis kommt an einer andere Stelle.
*: sog. Power Query Abfrage, das "no code/low code" Transformationstool von Excel. Viel leichter zu beherrschen als VBA.
VG
Yal

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread