06.10.2017

2661

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

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 351008

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

Ausgedruckt am: 24.11.2024 um 15:11 Uhr

17 Kommentare

Neuester Kommentar

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.

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

Mit Haltepunkte und Co. wirds noch eleganter.

Gruß,
Peter

Speditionsauftrag ist nirgendwo als Objekt deklariert, dann ist klar daß diese Fehlermeldung kommt.

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

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?

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ß

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

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 

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

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ß

???
@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!

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
    

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

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  

you made my day. thank you so much.

Нет причин!

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.

gelöst Frage VB for Applications Entwicklung

Mehr von specialuser

Installation Vcenter Serverspecialuser - 5 Kommentare

Excel VBA Programmierungspecialuser - 7 Kommentare

VBA Programmierungspecialuser - 4 Kommentare

Excel VBA Codespecialuser - 2 Kommentare

Heiß diskutiert