Excel VBA-Editor - Kopieren von Zellen

[Chris_1205]

Problem gelöst:

Private Sub CommandButton1_Click()
    ThisWorkbook.Worksheets("Aufmaßanfrage").Range("AB25").Copy
        Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Range("N985").PasteSpecial Paste:=xlPasteValues
        
    ThisWorkbook.Worksheets("Aufmaßanfrage").Range("L15").Copy
        Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Range("Q985").PasteSpecial Paste:=xlPasteValues
End Sub

dank dir trotzdem viel mals Thomas. Hast mir da sehr geholfen.

 

[Chris_1205]

Habe es jetzt sogar noch geschafft, dass er immer in die letzte Zeile der Tabelle springt und nicht die alten Daten überschreibt.

Private Sub CommandButton1_Click()
    Dim lngLast As Long
    
    ThisWorkbook.Worksheets("Aufmaßanfrage").Range("AB25").Copy
        lngLast = Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Cells(Rows.Count, "N").End(xlUp).Row + 1

        Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Range("N" & lngLast).PasteSpecial Paste:=xlPasteValues
        
    ThisWorkbook.Worksheets("Aufmaßanfrage").Range("L15").Copy
        Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Range("Q985").PasteSpecial Paste:=xlPasteValues
End Sub

Greetz Chris

 

[Chris_1205]

Hallo Thomas,
ich habe jetzt mal deinen Code mit den Pflichtfeldern ausprobiert. Der sieht dann wie folgt aus:

Private Sub CommandButton1_Click()
    Dim lngLast As Long
    
    
     If Trim(Range("G61").Value) = "" Or Trim(Range("I77").Value) = "" Then
    MsgBox "Die Zellen 'Datum' und 'Aufmaß-Nr' müssen ausgefüllt werden.", vbOKOnly, "Fehler"

End If
    
    'Regionalzentrum
        ThisWorkbook.Worksheets("Aufmaßanfrage").Range("L15").Copy
        lngLast = Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Cells(Rows.Count, "Q").End(xlUp).Row + 1
        Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Range("Q" & lngLast).PasteSpecial Paste:=xlPasteValues

End Sub

Das mit dem Prüfen funktioniert soweit auch, nur kopiert der mir die Daten dann trotzdem alle noch. Wahrscheinlich muss ich den Kopiervorgang in die Prüfung mit einbinden oder habe ich da sonst etwas über sehen?

Greetz Chris

 

[tombe]

Hi Chris,

du musst nach der Prüfung bzw. nach der Fehlermeldung den weiteren Ablauf unterbrechen:

If Trim(Range("G61").Value) = "" Or Trim(Range("I77").Value) = "" Then
    MsgBox "Die Zellen 'Datum' und 'Aufmaß-Nr' müssen ausgefüllt werden.", vbOKOnly, "Fehler"
'das hier hat gefehlt
    Exit Sub
End If

Hatte ich ganz oben aber auch vergessen, sorry.

Gruß Thomas

 

[Chris_1205]

Danke für die schnelle Antwort.
Aber das Kopieren erfolgt ja immer noch nach dem Prüfen der Zellen.
Mit dem Exit Sub hat sich bei mir nichts geändert. Muss ich das Kopieren nicht irgendwie in die Prüfung der Pflichtfelder einschliessen?

 

[tombe]

Hi Chris,
wenn ich es so schreibe wird die Prozedur verlassen (Exit Sub) wenn die Zellen G61 oder I77 leer sind.

Private Sub CommandButton1_Click()
Dim lngLast As Long
    
If Trim(Range("G61").Value) = "" Or Trim(Range("I77").Value) = "" Then
    MsgBox "Die Zellen 'Datum' und 'Aufmaß-Nr' müssen ausgefüllt werden.", vbOKOnly, "Fehler"
    Exit Sub
End If

'Regionalzentrum
ThisWorkbook.Worksheets("Aufmaßanfrage").Range("L15").Copy
        lngLast = Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Cells(Rows.Count, "Q").End(xlUp).Row + 1

Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Range("Q" & lngLast).PasteSpecial Paste:=xlPasteValues

End Sub

 

[Chris_1205]

Das Problem ist gelöst. Herzlichen Dank Thomas.
Ich habe aber wieder mal ein kleines Problem. Beim Kopieren meiner Daten aus der einen Datei in die andere, soll immer eine Zeile tiefer kopiert werden. Bisher ist mein Code wie folgt:

 ThisWorkbook.Worksheets("Aufmaßanfrage").Range("L15").Copy
        lngLast = Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Cells(Rows.Count, "Q").End(xlUp).Row + 1
        Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Range("Q" & lngLast).PasteSpecial Paste:=xlPasteValues

Das Problem hier ist aber, das er nun immer die letzte beschriebene Zeile nimmt. Es gibt aber manchmal auch leere Zeilen. Diese müssten dann übersprungen werden.
Wäre super wenn mir da jmd helfen könnte.

Greetz Chris

 

[tombe]

Das Problem hier bei ist das Excel ja nicht wissen kann ob nach der letzten beschriebenen Zeile nur 1, 2, oder X leere Zeilen kommen.

Kannst du nicht eine Hilfsspalte einsetzten in die dann z.B. nur ein "x" oder eine "1" eingetragen wird. Diese Spalte kann ja auch ausgeblendet werden, zu Überprüfung kann sie trotzdem benützt werden ohne dass sie die Optik stört.

Gruß Thomas

P.S. was war das Problem mit der Überprüfung weiter oben?

 

[Chris_1205]

Das Problem mit der Überpfüfung war, dass ich noch ein Else einfügen musste. Damit er nur kopiert falls die Pflichtfelder ausgefüllt sind.

Private Sub CommandButton1_Click()
    Dim lngLast As Long

    If Trim(Range("G61").Value) = "" Or Trim(Range("I77").Value) = "" Then
    MsgBox "Die Zellen 'Datum' und 'Aufmaß-Nr' müssen ausgefüllt werden.", vbOKOnly, "Fehler"
    
Else
    
    
    'Regionalzentrum
        ThisWorkbook.Worksheets("Aufmaßanfrage").Range("L15").Copy
        lngLast = Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Cells(Rows.Count, "Q").End(xlUp).Row + 1
        Workbooks("Aufmassdatei.xls").Worksheets("Aufmassdatei").Range("Q" & lngLast).PasteSpecial Paste:=xlPasteValues

Das mit der Hilfsspalte wäre in dem Sinne nicht so gut, da man dann dort ja auch was eintragen müsste. Das sollte wenn möglich automatisch gehen.
Gibt es denn die Möglichkeit das ich beim ersten Kopieren festlege wo er anfängt z.B. in Zeile 1 und das er dann bei jedem neuen Formular aus dem die Werte kopiert werden, eine Zeile tiefer springt.

Greetz Chris

 

[tombe]

Klar, du kannst eine allgemein gültige Variable erstellen und ihr dann die entsprechende Zeilennummer zuweisen.
Beim ersten Aufruf oder wenn die Variable noch keinen Wert hat kannst du ihr ja einen Anfangswert geben.

If zeile% = 0 Then
  zeile% = 1
Else
  zeile% = zeile% + 1
End If