specialuser
Oct 06, 2017
view2526
view17
0
Goto Top

Excel VBA Programmierung2

GermansolvedQuestionVB for ApplicationsDevelopment
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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 351008

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

Printed on: April 24, 2024 at 12:04 o'clock

17 Comments
Latest comment
Goto Top
Member: emeriks
Solution emeriks Oct 06, 2017 at 17:10:34 (UTC)
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.
Member: Pjordorf
Solution Pjordorf Oct 06, 2017 at 18:50:50 (UTC)
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
Solution 134464 Oct 07, 2017 updated at 05:27:46 (UTC)
Goto Top
Speditionsauftrag ist nirgendwo als Objekt deklariert, dann ist klar daß diese Fehlermeldung kommt.
Member: specialuser
specialuser Oct 10, 2017 updated at 09:53:36 (UTC)
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
Member: emeriks
emeriks Oct 10, 2017 at 10:02:22 (UTC)
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?
Member: specialuser
specialuser Oct 10, 2017 updated at 10:42:02 (UTC)
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 Oct 10, 2017 updated at 11:34:53 (UTC)
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
Member: specialuser
specialuser Oct 10, 2017 at 14:54:50 (UTC)
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 Oct 10, 2017 updated at 16:01:40 (UTC)
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
Member: specialuser
specialuser Oct 11, 2017 at 14:59:01 (UTC)
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ß
Member: emeriks
emeriks Oct 11, 2017 updated at 16:51:13 (UTC)
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!
Member: specialuser
specialuser Oct 12, 2017 at 06:29:49 (UTC)
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
Member: emeriks
emeriks Oct 12, 2017 at 08:21:09 (UTC)
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
Member: emeriks
Solution emeriks Oct 12, 2017 at 08:22:26 (UTC)
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
Member: specialuser
specialuser Oct 12, 2017 at 09:13:24 (UTC)
Goto Top
you made my day. thank you so much.
Member: emeriks
emeriks Oct 12, 2017 at 09:27:07 (UTC)
Goto Top
Нет причин!
Mitglied: 134464
134464 Oct 12, 2017 updated at 09:30:29 (UTC)
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.
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments