Daten Übertragung von Tabelle1 in Tabelle2

[Pirat2015]

Hallo Schauan,

ich bekomme folgenden Laufzeitfehler 438 "Objekt unterstützt diese Eigenschaft oder Methode nicht"

Fehler wird hier angezeigt

Code:

If Windows.Caption = MTL Then ThisWorkbook.Activate
Application.ScreenUpdating = True

Danke

[schauan]

Hallöchen,

da hab ich wohl nach dem Test noch Dein On Error Goto 0 verschoben

Nimm

ActiveWindow.Caption

[Pirat2015]

wo setze ich das ein? 
ich habe jetzt alles ausprobiert aber ich kriege ständig Fehler.

[Gast 123]

Hallo

ohne den Code zukennen und alle Antworten durchzulesen vermute ich von der Logik her mal hier:

Code:

If Windows.Caption = MTL Then ThisWorkbook.Activate

mfg Gast 123

[Pirat2015]

könnt Ihr den richtigen code schreiben? Danke.

[schauan]

Hallöchen,

in dem Codeteil

Code:

End If
On Error GoTo 0

If Windows.Caption = MTL Then ThisWorkbook.Activate
Application.ScreenUpdating = True

steckt ein Fehler:

Die Ursache ist die falsche Codierung ist:

statt
If Windows.Caption = MTL Then ThisWorkbook.Activate

schreibe bitte
If ActiveWindow.Caption = MTL Then ThisWorkbook.Activate

[Pirat2015]

nächster Fehler kommt:(

Laufzeitfehler 91 --> Objektvariable oder With-Blockvariable nicht festgelegt

Fehler kommt hier:

Code:

Set rFind = WbMt.Columns(1).Find(What:=AC.Value, After:=WbMt.Cells(1, 1), LookIn:= _
            xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)

Danke für unterstützung

[Käpt'n Blaubär]

Hallo,

... falsch gedacht,; drum wieder gelöscht

[schauan]

Hallöchen,

hast Du mal geprüft, ob Deine Materialliste offen ist? Ich hatte ja geschrieben, dass die bei mir wo anders liegt und ich deswegen den Pfad im Code geändert habe.
Unabhängig davon, falls die Datei nicht bei Makrostart offen ist und auch das Öffnen fehlschlägt, hattest Du keine weitere Fehlerbehandlung im Code.

Das könntest Du z.B. mit einer weiteren Codezeile so abfangen:

If Err > 0 Then
  Workbooks.Open Pfad & MTL
  Set WbMt = Workbooks(MTL).Worksheets(1)
  If WbMt Is Nothing Then MsgBox "Da stimmt was nicht": Exit Sub
End If

[Pirat2015]

Hallo Schauan,

danke für die Hilfe Test version läuft, wenn ich es aber in meine Datei anpasse braucht es sehr sehr lange.
Kann man den Code abändert, das es zuerst die Transportnummer sucht, dann denn Filter auf diese setz und dann die Containernummer entsprechend den Packstücken zu ordnet?
Weiterhin würde es sehr gut sein wenn das Marko die Tabelle selber öffnet.

hier meine überarbeiteter Code:

Code:

'Makro zum Übertrag in Materialliste
'42 ETA Port, 43 Container, 44 Transport Nr --> Material Liste

Sub Transportdaten_übertragen()
Dim AC As Range, rFind As Range
Dim Adr1 As String, j As Integer
Dim WbMt As Worksheet, lz1 As Long
Application.ScreenUpdating = False

On Error Resume Next
'Prüfen ob Materialübersicht offen ist, sonst Öffnen!
Set WbMt = Workbooks(MTL).Worksheets(1)
If Err > 0 Then
   Workbooks.Open Pfad & MTL
   Set WbMt = Workbooks(MTL).Worksheets(1)
End If
On Error GoTo 0

If ActiveWindow.Caption = MTL Then ThisWorkbook.Activate
Application.ScreenUpdating = True

With ThisWorkbook.Worksheets(1)
     'LastZell in Transportschein Spalte A suchen
     lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
     .Range(Status).Value = Empty  'Status löschen
     Application.ScreenUpdating = False
     
     'Schleife um alle Transportdaten zu übertragen
     For Each AC In .Range("D16:D" & lz1)
        Set rFind = WbMt.Columns(1).Find(What:=AC.Value, After:=WbMt.Cells(1, 1), LookIn:= _
            xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
        'Fehlermeldung wenn Packstück Nr. nicht gefunden wird!!
        If rFind Is Nothing Then MsgBox AC & "In Materialübersicht nicht gefunden!"
       
        If Not rFind Is Nothing Then
           Adr1 = rFind.Address
           Do
              rFind.Offset(0, 42) = AC.Offset(0, 19)  'ETA Port
              rFind.Offset(0, 43) = AC.Offset(0, 9)   'Container Nr.
              rFind.Offset(0, 44) = AC.Offset(0, 12)  'Transpor Nr.
              Set rFind = WbMt.Columns(1).FindNext(rFind)
           Loop Until Adr1 = rFind.Address
        End If
     Next AC
     
     'Anzeige der übertragenen Daten in Zelle I1
     .Range(Status).Value = "Daten von Packstück  " & .Cells(9, 1) & " bis " & .Cells(lz1, 1) & " übertragen"
End With
End Sub