Hilfe mit Makro

[johe]

Moin
Ich möchte bei Excel einen Warenkorb erstellen. In einem Blatt habe ich dazu die Liste mit den Artikeln, Preisen etc und natürlich die Bestellmenge. J
etzt habe ich folgendes Problem:
Der kunde soll mit einem klick auf einen Button die Bestelldaten in ein extra Blatt "Warenkorb" setzen. Dabei wird natürlich alles kopiert, allerdings nicht aktuallisiert, falls der Kunde die Bestellmenge ändert. Ich habe die Daten mit relativem Verweis kopiert, damit ich das Makro in allen Zellen verwenden kann und absolut in das zweite Blatt eingefügt, damit dort nichts verrutscht.
Wie bekomme ich es hin, dass sich die Bestellmenge ändert wenn der Kunde es im Bestellformular ändert, ohne für jeden Artikel ein eigenes Makro zu erstellen.

Code:

Sub Makro31()
'
' Makro31 Makro
'
'
    ActiveCell.Offset(0, -14).Range("A1:N1").Select
    Selection.Copy
    Sheets("Warenkorb").Select
    Range("A14").Select
    ActiveSheet.Paste
    Range("K14").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("L14").Select
    Selection.ClearContents
    Range("M14").Select
    Selection.ClearContents
    Range("N14").Select
    Selection.Cut
    Range("K14").Select
    ActiveSheet.Paste
    Range("M14").Select
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = "=RC[-5]"
    Range("L14").Select
    ActiveCell.FormulaR1C1 = "x"
    Range("N14:O14").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("K14:M14").Select
    Range("M14").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Rows("14:14").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("N15:O15,N15:O15").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("N14:O14").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("K15").Select
    ActiveCell.FormulaR1C1 = "=Angebot!R[5]C[4]"
    Range("K16").Select
    Sheets("Angebot").Select
    Range("Q19").Select
End Sub

Oder gibt es iwie eine einfachere möglichkeit. z,b, dass man das Bestellformular ausfüllt und einmalig ein Makro nutzt um alle Bestellten artikel in einen Warenkorb zu verschieben?

Für Hilfe schon mal vielen Dank.

[Wastl]

Hi,

das ist viel text der untereinander zusammenhanglos steht.
Mach doch bitte eine Beispieldatei daraus und lad sie hoch, sonstist helfen sehr unübersichtlich.
Danke im Voraus

[schauan]

Hallöchen,

Du könntest zuerst mal versuchen, Deinen Code zu optimieren.

Aus so etwas

Range("K14").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("L14").Select
Selection.ClearContents
Range("M14").Select
Selection.ClearContents

kann man so etwas machen:

Range("K14:M14").ClearContents



Wenn in Deinem Bestellformular alle Artikel aufgeführt sind, kannst Du die Zielzellen festlegen und den Code dann in einer Schleife durchlaufen lassen. Dazu kann man ein Array benutzen, da will ich aber jetzt nicht drauf eingehen.
Du könntest bei 5 Artikeln z.B. so vorgehen:

For iCnt = 1 to 5
If iCnt=1 then Ziel = "A1"
If iCnt=2 then Ziel = "A2"
...
hier Dein Code, irgendwo übernimmst Du die Daten mit Range(Ziel)=...
...
Next