mittels x eintrag von einer Excel-Datei in andere schreiben, dabei filter deaktiviere

[markusf1895]

Hallo

will von einer Excel-Datei bei "X" in Spalte J die gesamte Zeile in andere Excel-Datei verfrachten.
Dies geht bisher schief wenn bei letzterer Excel Datei noch Filter gesetzt werden und ich bekomme es gerade nicht geregelt

Code:

Sub Worksheet_Change(ByVal Target As Excel.Range)
Const strZiel As String = "C:\Users\msobotta\Desktop\Bestellungen.xlsx"
'"H:\WORKGROUP\Chemie Tech-Support\PuplicGroup\Bestellungen\Bestellungen.xlsx"
'anpassen verzeichnis
Dim wsQuelle As Worksheet
Dim wsZiel As Worksheet
Dim readZeile As Long
Dim writeZeile As Long
Dim writeinto As Workbook
Dim tabellenseite As String

tabellenseite = "Bestellungen " & Range("A1").Value

   If Target.Column = 10 And (Target.Value = "X" Or Target.Value = "x") Then
       'MsgBox "Sie haben etwas in Spalte J verändert!"
       
       
       
       Set wsQuelle = ActiveSheet
       Set writeinto = Workbooks.Open(strZiel)
       Set wsZiel = writeinto.Worksheets(tabellenseite)
       
       For Each it In writeinto.Worksheets(tabellenseite).ListObjects  'mein Versuch
        it.ShowAllData
       Next                                                            'bis hier
        
        readZeile = Target.Cells.Row
       writeZeile = writeinto.Worksheets(tabellenseite).Cells(Rows.Count, "B").End(xlUp).Row + 1
     
       
       wsZiel.Cells(writeZeile, "B").Value = wsQuelle.Cells(readZeile, "A").Value
       wsZiel.Cells(writeZeile, "C").Value = wsQuelle.Cells(readZeile, "B").Value
       wsZiel.Cells(writeZeile, "D").Value = wsQuelle.Cells(readZeile, "C").Value
       wsZiel.Cells(writeZeile, "F").Value = wsQuelle.Cells(readZeile, "D").Value
       wsZiel.Cells(writeZeile, "G").Value = wsQuelle.Cells(readZeile, "E").Value
       wsZiel.Cells(writeZeile, "H").Value = wsQuelle.Cells(readZeile, "F").Value

       
       
       writeinto.Close savechanges:=True
   End If
   
   Set wsZiel = Nothing
   Set wsQuelle = Nothing
   Set writeinto = Nothing
End Sub

wäre euch sehr verbunden
viele Grüße
Markus

[Flotter Feger]

Hallo,

du musst prüfen, ob

.Filtermode = True

Erst dann kannst du ohne Fehler .ShowAllData aufrufen.

[markusf1895]

Code:

Sub Worksheet_Change(ByVal Target As Excel.Range)
Const strZiel As String = "C:\Users\msobotta\Desktop\Bestellungen.xlsx"
'"H:\WORKGROUP\Chemie Tech-Support\PuplicGroup\Bestellungen\Bestellungen.xlsx"
'anpassen verzeichnis
Dim wsQuelle As Worksheet
Dim wsZiel As Worksheet
Dim readZeile As Long
Dim writeZeile As Long
Dim writeinto As Workbook
Dim tabellenseite As String

tabellenseite = "Bestellungen " & Range("A1").Value

   If Target.Column = 10 And IsDate(Target.Value) = True Then
   '(Target.Value = "" Or Target.Value = " " Or Target.Value = "tilt") Then
   'Column anpassen
       'MsgBox "Sie haben etwas in Spalte J verändert!"
       
       
       
       Set wsQuelle = ActiveSheet
       Set writeinto = Workbooks.Open(strZiel)
       Set wsZiel = writeinto.Worksheets(tabellenseite)
       
       

       For Each it In writeinto.Worksheets(tabellenseite).ListObjects
       If it.FilterMode = True Then
       it.ShowAllData
       End If
       Next
     
       
       readZeile = Target.Cells.Row
       writeZeile = writeinto.Worksheets(tabellenseite).Cells(Rows.Count, "B").End(xlUp).Row + 1
     
       
       wsZiel.Cells(writeZeile, "B").Value = wsQuelle.Cells(readZeile, "A").Value
       wsZiel.Cells(writeZeile, "C").Value = wsQuelle.Cells(readZeile, "B").Value
       wsZiel.Cells(writeZeile, "D").Value = wsQuelle.Cells(readZeile, "C").Value
       wsZiel.Cells(writeZeile, "F").Value = wsQuelle.Cells(readZeile, "D").Value
       wsZiel.Cells(writeZeile, "G").Value = wsQuelle.Cells(readZeile, "E").Value
       wsZiel.Cells(writeZeile, "H").Value = wsQuelle.Cells(readZeile, "F").Value

       
       
       writeinto.Close savechanges:=True
       Rows(readZeile).Hidden = True
   End If
   
   Set wsZiel = Nothing
   Set wsQuelle = Nothing
   Set writeinto = Nothing
End Sub

habs so versucht, aber das beseitigt das Problem ebenfalls nicht

[Kuwer]

Hallo Markus,

es gibt keine (intelligenten) Tabellen im Blatt "Bestellungen 2018", sondern nur den normalen Autofilter. Ersetze diese it-Schleife durch folgendes:

        If wsZiel.AutoFilterMode Then

         If wsZiel.FilterMode Then

           wsZiel.ShowAllData

         End If

       End If

Gruß Uwe

[markusf1895]

Danke für eure Mühen, nur leider nach wie vor, das Problem bleibt.

Wenn ich in den Bestellungen beispielsweise nach Kevin filtere.
Dann einen Eintrag mittels Anfragenliste an die Bestellliste übermittelt,
wird der Eintrag, unter dem letzten Eintrag von Kevin, überschrieben.

Eigentlich hätte er die Filter entfernen sollen, dann die Zeile bestimmen, welche die letzte freie ist und es dort eintragen.
Sodass niemals andere Einträge überschrieben werden.


Hoffe Ihr könnt mir helfen

[Kuwer]

Hallo,

Danke für eure Mühen, nur leider nach wie vor, das Problem bleibt.

dann hattest Du meinen Tipp nicht umgesetzt!


Hier noch mal das komplette Makro:

Sub Worksheet_Change(ByVal Target As Excel.Range)

   Const strZiel As String = "C:\Users\msobotta\Desktop\Bestellungen.xlsx"

   '"H:\WORKGROUP\Chemie Tech-Support\PuplicGroup\Bestellungen\Bestellungen.xlsx"

   'anpassen verzeichnis

   Dim wsQuelle As Worksheet

   Dim wsZiel As Worksheet

   Dim readZeile As Long

   Dim writeZeile As Long

   Dim writeinto As Workbook

   Dim tabellenseite As String

   Dim it As ListObject



   If Target.Column = 10 And (Target.Value = "X" Or Target.Value = "x") Then

       'MsgBox "Sie haben etwas in Spalte J verändert!"

       tabellenseite = "Bestellungen " & Range("A1").Value

       Set wsQuelle = ActiveSheet

       Set writeinto = Workbooks.Open(strZiel)

       Set wsZiel = writeinto.Worksheets(tabellenseite)

       

       For Each it In wsZiel.ListObjects

         If it.AutoFilter.FilterMode Then

           it.AutoFilter.ShowAllData

         End If

       Next

       

       If wsZiel.AutoFilterMode Then

         If wsZiel.FilterMode Then

           wsZiel.ShowAllData

         End If

       End If

       

       readZeile = Target.Cells.Row

       writeZeile = writeinto.Worksheets(tabellenseite).Cells(Rows.Count, "B").End(xlUp).Row + 1

       wsZiel.Cells(writeZeile, "B").Value = wsQuelle.Cells(readZeile, "A").Value

       wsZiel.Cells(writeZeile, "C").Value = wsQuelle.Cells(readZeile, "B").Value

       wsZiel.Cells(writeZeile, "D").Value = wsQuelle.Cells(readZeile, "C").Value

       wsZiel.Cells(writeZeile, "F").Value = wsQuelle.Cells(readZeile, "D").Value

       wsZiel.Cells(writeZeile, "G").Value = wsQuelle.Cells(readZeile, "E").Value

       wsZiel.Cells(writeZeile, "H").Value = wsQuelle.Cells(readZeile, "F").Value

       writeinto.Close savechanges:=True

   End If

   

   Set wsZiel = Nothing

   Set wsQuelle = Nothing

   Set writeinto = Nothing

End Sub

Gruß Uwe

[markusf1895]

vielen Dank
entschuldige, keine Ahnung was ich zuvor verkackt hatte.