specialuser
Goto Top

Excel VBA Programmierung2

Hallo allerseits,

Habe hier ein VBA Projekt, bei welchem eine Schleife Prüft ob in bestimmten Zellen Werte stehen und daraufhin aus einer anderen Zelle Daten in eine neue Excel Datei exportiert, eigentlich müsste es funktionieren tut es aber leider nicht und ich finde den Fehler nicht. Wenn ich den Code ausführe kommt die Fehlermeldung 424 Objekt erforderlich. Was mache ich falsch?

Private Sub öffneVersandübersicht_Click()
    Dim wb2 As Workbook
    Set wb2 = Workbooks.Open("M:\6_Logistik\01_Spedition\02_Versandübersicht\Versandübersicht.xlsx")  
    ThisWorkbook.Activate
            If IsNumeric(Speditionsauftrag.Range("A43").Value) = True Then  
            Sheets(1).Range("K65").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            End If
            If IsNumeric(Speditionsauftrag.Range("A45").Value) = True Then  
            Sheets(1).Range("K70").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            End If
            If IsNumeric(Speditionsauftrag.Range("A47").Value) = True Then  
            Sheets(1).Range("K71").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            End If
            If IsNumeric(Speditionsauftrag.Range("A49").Value) = True Then  
            Sheets(1).Range("K72").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            End If
            If IsNumeric(Speditionsauftrag.Range("A51").Value) = True Then  
            Sheets(1).Range("K72").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            End If
            If IsNumeric(Speditionsauftrag.Range("A53").Value) = True Then  
            Sheets(1).Range("K72").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            End If
            With Sheets(1).Range("A38").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            Sheets(1).Range("E4").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "C").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            Sheets(1).Range("L24").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            Sheets(1).Range("A55").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "H").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            Sheets(1).Range("L30").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "E").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            Sheets(1).Range("N30").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "F").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            Sheets(1).Range("K38").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "G").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            Sheets(1).Range("L55").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "J").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            Sheets(1).Range("A55").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "H").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
            End With
End Sub

Content-Key: 351008

Url: https://administrator.de/contentid/351008

Ausgedruckt am: 19.03.2024 um 09:03 Uhr

Mitglied: emeriks
Lösung emeriks 06.10.2017 um 19:10:34 Uhr
Goto Top
Hi,
setze einen Haltepunkt in Zeile 3. Dann führe den Code ab dort in Einzelschritten aus. So bekommst Du erstmal heraus, in welcher Zeile dieser Fehler auftritt. Ohne Kenntnis dieser Zeile würde das alles nur langweiliges Rätselraten.

E.
Mitglied: Pjordorf
Lösung Pjordorf 06.10.2017 um 20:50:50 Uhr
Goto Top
Hallo,

Zitat von @specialuser:
Was mache ich falsch?
Du hast dich nicht damit beschäftigt wie Werkzeug zu handhaben ist. Handbuch lesen hilft sehr oft weiter. Dein VBA hat ein Entwicklerumgebung wo du Zeile für Zeile per Tastendruck (Einzelschritt) dein Quellcode ablaufen lassen kannst. Das nennt sich EinzelSchritt und kann auch per F8 gestartet werden. Wenn du dann Schritt für Schritt dein Quellcode durchtackerst, kommt irgendwann die Stelle wleche diesen Fehler auslöst und schon bist du schlauer face-smile Mit Haltepunkte und Co. wirds noch eleganter.

Gruß,
Peter
Mitglied: 134464
Lösung 134464 07.10.2017 aktualisiert um 07:27:46 Uhr
Goto Top
Speditionsauftrag ist nirgendwo als Objekt deklariert, dann ist klar daß diese Fehlermeldung kommt.
Mitglied: specialuser
specialuser 10.10.2017 aktualisiert um 11:53:36 Uhr
Goto Top
Hallo Emeriks,

vielen Dank für deine Antwort. Diesen VBA code welchen ich gerne abändern möchte und zwar soll der Code so funktionieren das wenn K65 in die nächst freie Zelle von Spalte I kopiert wird der Inhalt aus K70,K71,K72 und K73 in genau dieselbe Zelle kopiert wird und nicht wie jetzt festgelegt in die nächst freie wie kann ich das Umsetzen hättest du da eine Idee ich habe es schon mit ActiveCell probiert aber damit funktioniert es nicht.

Private Sub öffneVersandübersicht_Click()
Dim wb2 As Workbook
Set wb2 = Workbooks.Open("M:6_Logistik1_Spedition2_VersandübersichtVersandübersicht - Kopie.xlsx")  
ThisWorkbook.Activate
If IsEmpty(Range("A43").Value) = False Then  
Sheets(1).Range("K65").Copy  
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
If IsEmpty(Range("A45").Value) = False Then  
Sheets(1).Range("K70").Copy  
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
If IsEmpty(Range("A47").Value) = False Then  
Sheets(1).Range("K71").Copy  
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
If IsEmpty(Range("A49").Value) = False Then  
Sheets(1).Range("K72").Copy  
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
If IsEmpty(Range("A51").Value) = False Then  
Sheets(1).Range("K73").Copy  
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
End If
End If
End If
End If
End If
End If
With Sheets(1).Range("A38").Copy  
wb2.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
Sheets(1).Range("E4").Copy  
wb2.Sheets(1).Cells(Rows.Count, "C").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
Sheets(1).Range("L24").Copy  
wb2.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
Sheets(1).Range("A55").Copy  
wb2.Sheets(1).Cells(Rows.Count, "H").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
Sheets(1).Range("L30").Copy  
wb2.Sheets(1).Cells(Rows.Count, "E").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
Sheets(1).Range("N30").Copy  
wb2.Sheets(1).Cells(Rows.Count, "F").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
Sheets(1).Range("K38").Copy  
wb2.Sheets(1).Cells(Rows.Count, "G").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
Sheets(1).Range("L55").Copy  
wb2.Sheets(1).Cells(Rows.Count, "J").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
End With
End Sub
Mitglied: emeriks
emeriks 10.10.2017 um 12:02:22 Uhr
Goto Top
Deutsch!
... wenn K65 in die nächst freie Zelle von Spalte I kopiert wird der Inhalt aus K70,K71,K72 und K73 in genau dieselbe Zelle kopiert wird ...
Wie jetzt? Der Reihe nach und dabei immer wieder überschreiben oder aneinander ketten?
Mitglied: specialuser
specialuser 10.10.2017 aktualisiert um 12:42:02 Uhr
Goto Top
Erst soll die erste freie Zeile von Spalte I gesucht werden und dann der Inhalt von K65, K70, K71, K72 und K73 in diese erste freie Zelle geschrieben werden..dh. aneinander Ketten.

gruß
Mitglied: 134464
134464 10.10.2017 aktualisiert um 13:34:53 Uhr
Goto Top
Grundlagen ...
With Sheets(1)
    .Cells(Rows.Count,"I").End(xlUp).Offset(1,0).Value = .Range("K65").Value & " " & .Range("K70").Value & " " & .Range("K71").Value & " " & .Range("K72").Value & " " & .Range("K73").Value  
End with
Mitglied: specialuser
specialuser 10.10.2017 um 16:54:50 Uhr
Goto Top
Ich glaube du hast mich falsch verstanden ich möchte das nämlich in diesen Teil integrieren und keinen neuen Befehl daraus machen..

Private Sub öffneVersandübersicht_Click() 
Dim wb2 As Workbook 
Set wb2 = Workbooks.Open("M:6_Logistik1_Spedition2_VersandübersichtVersandübersicht - Kopie.xlsx")   
ThisWorkbook.Activate 
If IsEmpty(Range("A43").Value) = False Then   
Sheets(1).Range("K65").Copy   
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)   
If IsEmpty(Range("A45").Value) = False Then   
Sheets(1).Range("K70").Copy  
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)   
If IsEmpty(Range("A47").Value) = False Then   
Sheets(1).Range("K71").Copy   
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)   
If IsEmpty(Range("A49").Value) = False Then   
Sheets(1).Range("K72").Copy   
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)   
If IsEmpty(Range("A51").Value) = False Then   
Sheets(1).Range("K73").Copy   
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)   
End If
End If
End If 
End If 
End If 
Mitglied: 134464
134464 10.10.2017 aktualisiert um 18:01:40 Uhr
Goto Top
Ich glaube du hast mich falsch verstanden
Nö, das macht exakt das was du oben im Kommentar geschilderten hast!!
Brauchst du nur an deiner gewünschten Stelle einbauen, ich poste hier doch nicht Code doppelt ...
Man man man, bloß nicht das Oberstübchen überfordern was, und mal verstehen was in meinem Code passiert ??!
Du bist hier bei Administrator.de und nicht bei Bild.de
Mitglied: specialuser
specialuser 11.10.2017 um 16:59:01 Uhr
Goto Top
Okey, wie kann ich das hinbekommen, dass alle Werte In die erst freie Zeile von I geschrieben werden? Habe Offset auf 0 gestellt aber hat nichts gebracht. Weis das zufällig jemand. Bis jetzt werden nämlich alle Werte welche in K65, K70, K71 usw in Spalte I geschrieben aber leider untereinander und nicht in die selbe Zelle.

Gruß
Mitglied: emeriks
emeriks 11.10.2017 aktualisiert um 18:51:13 Uhr
Goto Top
???
@kokosnuss hat Dir doch ne Lösung gegeben, bei welcher die Werte alle in eine Zelle geschrieben werden. Das wolltest Du doch haben?!
aber leider untereinander und nicht in die selbe Zelle.
Das kann nicht sein.
Dieser Code von @kokosnuss schreibt es in eine Zelle!
With Sheets(1)
    .Cells(Rows.Count,"I").End(xlUp).Offset(1,0).Value = .Range("K65").Value & " " & .Range("K70").Value & " " & .Range("K71").Value & " " & .Range("K72").Value & " " & .Range("K73").Value  
End with
Veralbere uns nicht!
Mitglied: specialuser
specialuser 12.10.2017 um 08:29:49 Uhr
Goto Top
Ich will euch nicht veralbern, ich hab das so probiert, aber er schreibt es nicht in eine zelle

With Sheets(1)
    .Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).Value = .Range("K70").Value & " " & .Range("K71").Value & " " & .Range("K72").Value & " " & .Range("K73").Value  
    .Range("K70").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)  
    .Range("K71").Copy  
            wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)  
End With
    
Mitglied: emeriks
emeriks 12.10.2017 um 10:21:09 Uhr
Goto Top
Du willst doch vom aktuellen Sheet in ein neues kopieren, richtig?
Also von "aktuell" nach "wb2".
Also müsst doch der befehl so lauten: ?
With Sheets(1)
  wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).Value = .Range("K70").Value & " " & .Range("K71").Value & " " & .Range("K72").Value & " " & .Range("K73").Value  
End With
Mitglied: emeriks
Lösung emeriks 12.10.2017 um 10:22:26 Uhr
Goto Top
oder übersichtlicher
Dim NewValue
With Sheets(1)
  NewValue = .Range("K70").Value & " " & .Range("K71").Value & " " & .Range("K72").Value & " " & .Range("K73").Value  
End With
wb2.Sheets(1).Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).Value = NewValue  
Mitglied: specialuser
specialuser 12.10.2017 um 11:13:24 Uhr
Goto Top
you made my day. thank you so much.
Mitglied: emeriks
emeriks 12.10.2017 um 11:27:07 Uhr
Goto Top
Нет причин!
Mitglied: 134464
134464 12.10.2017 aktualisiert um 11:30:29 Uhr
Goto Top
Da sieht man mal wieder das sich die meisten TOs hier in keinster Weise mit dem Code auseinander setzen und noch nicht mal das Zielsheet angeben können. Armes Deutschland ... da liefert man es schon frei Haus und es ist immer noch nicht genug.