|
Guten Tag und Hallo,
bin ein totaler Anfänger in VBA und möchte hier mal um Hilfe bitten.
Mein Problem:
Ich verwalte in Excel meinen Angebote. Registerkarte 1 enthält den Kundenstamm. Registerkarte 2 enthält die Auftragsliste. Zuerst kommen in der Auftragsliste die Kundendateneingaben mit Pulldownmenue bzw. dann Kontaktdaten mit S-Verweisen (das Übliche), dann der Auftrag, dann die Mengen und Preise. Alles jeweils in einer Zeile. Nun kommt es vor, dass für einen Auftrag mehrere Anfragen erhalte und ich die bereits geschriebenen Auftragsdaten ans Ende der Tabelle in Registerkarte 2 kopieren möchte. Jedoch ohne die Kundendaten, da die gleiche Anfrage logischerweise von einem anderen Kunden eingeht. Am Ende der Tabelle würde ich dann nur den neuen Kunden ergänzen, müsste aber nicht die Daten von Hand alle kopieren.
Also möchte ich eine Feldeingabe machen mit der entsprechenden Zeilennumereingabe (oben über der Tabelle). Diese würde dann automatisch ans Ende der Tabelle die Daten des Auftrages kopieren aber nur bestimmte Zellen. Ich habe anbei mal einen älteren Code beigefügt, der aber nicht funktioniert. In einer anderen Datei aber seinen Dienst getan hat. Diese konnte sogar in einer zweiten Zelleneingabe bestimmte selektierte Werte wieder löschen. Das wäre toll, wenn das auch wieder ginge.
Ich hoffe, ich habe mein Problem möglichst präzise geschildert.
Alter Code zum kopieren einer bestimmten Zeile:
Private Sub Anfragekopieren_Click()
Dim Anfrage As Variant
Anfrage = Worksheets("Angebotserfassung").Range("A2").Value
If Anfrage > 4 Then
Set cpy = Range(Cells(Anfrage + 4, 12), Cells(Anfrage + 4, 30))
Set cpy2 = Range(Cells(Anfrage + 4, 34), Cells(Anfrage + 4, 35))
Dim Zeile As Integer
Zeile = Cells(Rows.Count, 2).End(xlUp).Row
cpy.Copy Destination:=Cells(Zeile + 1, 12)
cpy2.Copy Destination:=Cells(Zeile + 1, 34)
ActiveSheet.Range("A2") = ""
ElseIf Anfrage <= 4 Then
MsgBox "Zeilennummer prüfen!"
End If
End Sub
Code zum löschen der Inhalte einer bestimmten Zeile:
Private Sub Anfragelöschen_Click()
Dim Anfrage As Variant
Anfrage = Worksheets("Angebotserfassung").Range("H2").Value
If Anfrage > 4 Then
Dim Zeile As Integer
Zeile = Cells(Rows.Count, 2).End(xlUp).Row
Dim BM As String
BM = Cells(Zeile + 1, 12)
Dim byWert As Byte
byWert = MsgBox("Anfrage in Zeile " & Anfrage & ": " & vbCrLf & vbCrLf & BM & vbCrLf & vbCrLf & "löschen?", 1, "Schalterabfrage")
If byWert = 2 Then
MsgBox "Anfrage in Zeile " & Anfrage & ": " & BM & " wird nicht gelöscht"
ElseIf byWert = 1 Then
MsgBox "Anfrage in Zeile " & Anfrage & ": " & BM & " wird gelöscht"
ActiveSheet.Range(Cells(Anfrage + 4, 12), Cells(Anfrage + 4, 19)) = ""
ActiveSheet.Range(Cells(Anfrage + 4, 21), Cells(Anfrage + 4, 21)) = ""
ActiveSheet.Range(Cells(Anfrage + 4, 31), Cells(Anfrage + 4, 51)) = ""
ActiveSheet.Range(Cells(Anfrage + 4, 53), Cells(Anfrage + 4, 57)) = ""
ActiveSheet.Range("h2") = ""
End If
Else
End If
End Sub |