Zelle kopieren mit Makro

[Statler]

Ich habe es Dir mit einem sehr ausführlichen DIM-Kopf programmiert (insofern man das bei einem solchen Mini-Progrämmchen sagen kann)
So kannst Du viele Parameter sehr einfach einstellen (welche Zeile, welche Spalte soll der erste Eintrag der Informationen stehen).

Code:

Sub Makro1()
  'Bedingung Start ist immer in Zeile 4
  'Änderung der "Nr. Rg" Zelle ist Initiator für neue Berechnung - alle anderen Nr.Rg Zellen sind leer
  '1. BestellDatum ist in Zeile 4
  '1. Rechnungsdatum ist in Zeile 5
  Dim StartZelle As String
  Dim Startzeile As Integer
  Dim Bestelldatum_Zeile As Integer
  Dim RechungsDatum_Zeile As Integer
  Dim AktuelleZeile As Integer
  Dim Kundenname As String
  Dim AnzahlTage_Spalte As String
  Dim Rechnungsdatum_Spalte As String
  Dim BestellDatum_Spalte As String
  Dim SheetName As String
 
  StartZelle = "C4"
  Kundenname = "A"
  AnzahlTage_Spalte = "G"
  Rechungsdatum_Spalte = "D"
  BestellDatum_Spalte = "F"
  Startzeile = 4
  Bestelldatum_Zeile = 4
  RechnungsDatum_Zeile = 4
  AktuelleZeile = Startzeile
  SheetName = "Tabelle1"
 
 
     
  Rechnungsnummer_neu = Worksheets(SheetName).Range(StartZelle).Value
  Do Until Worksheets(SheetName).Range(Kundenname & AktuelleZeile).Value = ""
                        'Abbruchbedingung Kundenzelle A... ist leer
        Worksheets(SheetName).Range(AnzahlTage_Spalte & AktuelleZeile).Select
        If Worksheets(SheetName).Range(Rechungsdatum_Spalte & AktuelleZeile).Value <> "" Then
                        'Wenn es einen neuen RechnungsDatumsEintrag gibt, dann nimm die neue Rechnungsdatumszeile
        RechnungsDatum_Zeile = ActiveCell.Row()
        NaechsteZeile = RechnungsDatum_Zeile + 1
        Worksheets(SheetName).Range(AnzahlTage_Spalte & AktuelleZeile).Value = Worksheets(SheetName).Range(Rechungsdatum_Spalte & NaechsteZeile).Value - Worksheets(SheetName).Range(BestellDatum_Spalte & Bestelldatum_Zeile).Value
                         'BestellDatum_Zeile = BestellDatum_Zeile + 1 'Neu
        Else
        Worksheets(SheetName).Range(AnzahlTage_Spalte & AktuelleZeile).Value = Worksheets(SheetName).Range(Rechungsdatum_Spalte & RechnungsDatum_Zeile).Value - Worksheets(SheetName).Range(BestellDatum_Spalte & Bestelldatum_Zeile).Value
        End If
          Inc Bestelldatum_Zeile
          Inc AktuelleZeile
  Loop
End Sub
Function Inc(ByRef i As Integer)
    i = i + 1
End Function

Gruß
Statler

[Statler]

Wenn Du die jeweils erste Zeile mit den Tagen leer haben möchtest mußt Du nur ein   '     in folgende Zeile vor dem Minus-Zeichen einfügen

  Worksheets(SheetName).Range(AnzahlTage_Spalte & AktuelleZeile).Value = Worksheets(SheetName).Range(Rechungsdatum_Spalte & NaechsteZeile).Value ' - Worksheets(SheetName).Range(BestellDatum_Spalte & Bestelldatum_Zeile).Value

Gruß
Statler