Bitte Hilfe - ich kann das Makro nicht anpassen!!!

Liebes Forum,
angehängt eine Datei, bei der mir bereits jemand aus dem Forum super geholfen hat. Jetzt stehe ich aber vor einem großen Problem. (siehe Anlage)
im Sheet Businessplan Menge gibt es den Button "Aktualisieren" (der mir Datensätze aus dem Sheet (Datensätze, Menge) herüberschaufelt. Für jeden neuen Datensatz (Land, das in dem Sheet (Datensätze, Menge) unten angehängt wird, wird eine neue Zeile in "Businessplan Menge eingefügt und mit den Daten für Planumsatz und Plan-DB befüllt.
Wenn ich jetzt im Feld B 39 oder C 39 oder B40 oder C40 (oder auch in weiteren Spalten, die automatisch eingefügt werden) einen Wert eingebe, wird er beim Drücken des Buttons "Aktualisieren" gelöscht.
Das sollte nicht sein, kann sich das jemand bitte ansehen - wäre eine tolle Hilfe.
Alles funktioniert sehr gut, soll es auch weiterhin, nur diese Spalte B un C soll von der Aktualisierung ausgenommen werden und immer frei befüllbar sein.
ich hoffe, ich habe es nicht zu kompliziert beschrieben.
https://www.herber.de/bbs/user/33857.xls
Gruß
Andreas aus Österreich

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andreas,
so könnte es gehen. Aber das ist nur ne Krücke da der Rest vom Makro nicht gerade übersichtlich und professionell programmiert ist.
Bei deiner Mappe die du hier hochgeladen hast klappt das jetzt jedenfalls.


Sub Uebertrag_in_Businessplan_Menge()
'neu
Dim arrDaten As Variant
Dim wks1, wks2 As Worksheet
Dim ALetzte1, ALetzte2, i, j As Long
Dim Reg As String
Dim SuchReg As Range
Application.ScreenUpdating = False
Set wks1 = Sheets("Datensätze (Menge)")
Set wks2 = Sheets("Businessplan_Menge")
ALetzte1 = IIf(IsEmpty(wks1.Cells(Rows.Count, 1)), wks1.Cells(Rows.Count, 1).End(-4162).Row, Rows.Count)
ALetzte2 = IIf(IsEmpty(wks2.Cells(Rows.Count, 1)), wks2.Cells(Rows.Count, 1).End(-4162).Row, Rows.Count)
If ALetzte2 > 40 Then
'neu
arrDaten = wks2.Range(Cells(39, 2), Cells(ALetzte2 - 2, 3))
wks2.Rows("39:" & ALetzte2 - 2).Delete Shift:=xlUp
End If
For i = 3 To ALetzte1
If wks1.Cells(i, 1) = "Region oder Segment:" Then
Reg = wks1.Cells(i, 2)
wks2.Rows("39:39").Insert Shift:=xlDown
wks2.Range("A39").Value = Reg
For j = 4 To 6
wks2.Cells(39, j) = wks1.Cells(i + 28, j - 2)
Next j
For j = 7 To 9
wks2.Cells(39, j) = wks1.Cells(i + 35, j - 5)
Next j
End If
Next i
'neu
wks2.Range(Cells(39, 2), Cells(ALetzte2 - 2, 3)) = arrDaten
Application.ScreenUpdating = True
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !

Sub Uebertrag_in_Businessplan_Menge() Dim wks1, wks2 As Worksheet Dim ALetzte1, ALetzte2, i, j As Long Dim Reg As String Dim SuchReg As Range Application.ScreenUpdating = False Set wks1 = Sheets("Datensätze (Menge)") Set wks2 = Sheets("Businessplan_Menge") ALetzte1 = IIf(IsEmpty(wks1.Cells(Rows.Count, 1)), wks1.Cells(Rows.Count, 1).End(-4162).Row, Rows.Count) ALetzte2 = IIf(IsEmpty(wks2.Cells(Rows.Count, 1)), wks2.Cells(Rows.Count, 1).End(-4162).Row, Rows.Count) If ALetzte2 > 40 Then wks2.Rows("39:" & ALetzte2 - 2).Delete Shift:=xlUp For i = 3 To ALetzte1 If wks1.Cells(i, 1) = "Region oder Segment:" Then Reg = wks1.Cells(i, 2) wks2.Rows("39:39").Insert Shift:=xlDown wks2.Range("A39").Value = Reg For j = 4 To 6 wks2.Cells(39, j) = wks1.Cells(i + 28, j - 2) Next j For j = 7 To 9 wks2.Cells(39, j) = wks1.Cells(i + 35, j - 5) Next j End If Next i Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Bitte Hilfe - ich kann das Makro nicht anpassen!!!

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread