Excel VBA Makro für Copy/paste

[Gigbert62]

Hallo zusammen,
bin mir sicher meine Herausforderung ist eine recht "einfache" Sache, bin allerdings nicht sehr erfahren in VBA Programmierung. Hoffe jemand kann mir helfen (und ich lern dazu).

Folgende "Problemstellung":

In der Excel Datei möchte ich einen bestimmtem Bereich kopieren und in dem gleichen Bereich, nur eine Zeile darunter, wieder als Wert einfügen. Die Daten in der Kopierzeile sind Formeln.

Die Zeile aus der Kopiert werden finde ich über einen Begriff in Spalte "C". (PLan_Order)
Der Bereich der kopiert werden soll ist in der gleichen Zeile, Range von E:AA
Der Einfügebereich ist immer die nächste Zeile, gleicher Bereich, allerdings nur die reinen Werte.

Das ganze soll solange passieren bis Ende erreicht ist.

Habe ich das einigermaßen verständlich erklärt.


Besten Dank vorab
Dirk

[schauan]

Hallo Dirk,

wenn Du schon etwas von VBA weißt, dann erst mal nur ein paar Stichpunkte. Wenn's nicht reicht, einfach nochmal fragen.
Für die ersten Schritte ist der Makrorekorder ganz gut - findest Du im Ribbon Entwicklertools - Makro aufzeichnen. Damit könntest Du z.B. die Suche nach Deinem Begriff durchführen. Bei der Suche wird die Zelle markiert, Du könntest dann also mit ActiveCell.Row weiterarbeiten. Geht auch anders, aber erst mal diese Variante für den Anfang.
Range(cells(Activecell.row,5),Activecell.row,"AA").Copy
Statt AA nimmst Du die Spaltenzahl. AA geht auch, aber die Zahl ist professioneller

Zum Einfügen wäre die letzte belegte Zelle von Interesse. Ich habe die hier mal anhand Spalte A ermittelt:
Cells(Rows.Count, 1).End(xlUp).Row
Eine Einschränkung gibt es - wenn die Spalte komplett leer ist oder nur in A1 was steht, kommt als Ergebnis für beides 1.

[Gigbert62]

Hallo Dirk,

wenn Du schon etwas von VBA weißt, dann erst mal nur ein paar Stichpunkte. Wenn's nicht reicht, einfach nochmal fragen.
Für die ersten Schritte ist der Makrorekorder ganz gut - findest Du im Ribbon Entwicklertools - Makro aufzeichnen. Damit könntest Du z.B. die Suche nach Deinem Begriff durchführen. Bei der Suche wird die Zelle markiert, Du könntest dann also mit ActiveCell.Row weiterarbeiten. Geht auch anders, aber erst mal diese Variante für den Anfang.
Range(cells(Activecell.row,5),Activecell.row,"AA").Copy
Statt AA nimmst Du die Spaltenzahl. AA geht auch, aber die Zahl ist professioneller

Zum Einfügen wäre die letzte belegte Zelle von Interesse. Ich habe die hier mal anhand Spalte A ermittelt:
Cells(Rows.Count, 1).End(xlUp).Row
Eine Einschränkung gibt es - wenn die Spalte komplett leer ist oder nur in A1 was steht, kommt als Ergebnis für beides 1.

Hi Andrè,

besten dank für den Einstieg. Ich häng mal eine Beispieldatei dran wo ich mit dem Recorder die Schritte bzw. Ablauf aufgezeichnet habe. 
Ist doch einfacher zu erklären als mit Worten.

Das ganze sollte im loop ( do until?) bis zum letzten Datensatz passieren, das können schon so an die 200 Kopiervorgänge sein.

Und mit dieser automatischen Wiederholung tue ich mich schwer (bzw. krieg ich nicht hin  .

Dank für die Hilfe
Dirk

[schauan]

Hallo Dirk,

das mit der Zeile usw. hast Du aber noch nicht probiert, einzusetzen

Ich habe hier mal den code überarbeitet, aber noch nicht getestet. Du siehst, es ist deutlich kürzer geworden. Die Aktion mit dem Kopieren und Einfügen bekommt man in zwei Zeilen. Die Sache mit dem Select und einer folgenden Aktion kann man nämlich meist zusammenfassen.
Ich habe auch viele Kommentare eingefügt. Ist nicht verkehrt, zum einen für das Verständnis beim Programmieren, zum anderen, wenn Du in einem Jahr was ändern willst und da gleich siehst, wozu Du mal was programmiert hast.
Als rechte Spalte hab ich hier mal 55 gesetzt. Du hast die ja auch dynamisch ermittelt: Selection.End(xlToRight) Im Prinzip kann man das so ähnlich umsetzen wie ich es bei der Zeile gemacht habe. Nur eben mit Right und Column ...

Code:

Sub Copy_Paste_Value_RP()
' Copy_Paste_Value_RP Makro
'
'Variablendeklarationen
'Long
Dim lRow As Long
'String
Dim strTreffer As String
   'Spalte C auswaehlen
   Columns("C:C").Select
   'Suchbegriff finden
   Selection.Find(What:="SAP_PLAN", After:=ActiveCell, LookIn:=xlFormulas, _
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
       MatchCase:=False, SearchFormat:=False).Activate
   strTreffer = ActiveCell.Address
   'Schleife ueber alle Treffer
   Do
     'Zeilennummer der aktiven Zelle feststellen
     lRow = ActiveCell.Row
     'Bereich ab Spalte E kopieren und unterhalb einfuegen
     Range(Cells(lRow, 5), Cells(lRow, 55)).Copy
     Cells(Cells(Rows.Count, 5).End(xlUp).Row + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
     'naechste Fundstelle suchen
     Selection.FindNext(After:=ActiveCell).Activate
   'Ende Schleife ueber alle Treffer, wenn erster Treffer wieder erreicht ist
   Loop Until ActiveCell.Address = strTreffer
End Sub

[Gigbert62]

Hi Andre,
habe deinen ersten Hinweis noch nicht eingesetzt da ich nichts zum einsetzen hatte .

Habe den Code mal ausprobiert, läuft leider noch nicht rund. Habe mal bischen was ausprobiert aber komme irgendwie auf keinen grünen Zweig.

Wenn ich den Code laufen lasse, wird der erste Treffer wo SAP_PLAN steht in die letzte Zeile kopiert (unter SAP_PLan).

Und der Code läuft auf Fehler.

Aktuelle Datei noch mal im Anhang, mit dem Ergebnis und der Fehlermeldung.

Wenn Du Lust und Zeit hast kannst Du ja noch mal nachschauen. Ich denke ich brauche das nur mal zu sehen um zu verstehen,
bekomme jetzt diese Art von Anforderungen öfter und würde mir sehr helfen wenns einmal läuft.

Dank nochmals und schönen Sonntag
Dirk

Hallo Dirk,

das mit der Zeile usw. hast Du aber noch nicht probiert, einzusetzen

Ich habe hier mal den code überarbeitet, aber noch nicht getestet. Du siehst, es ist deutlich kürzer geworden. Die Aktion mit dem Kopieren und Einfügen bekommt man in zwei Zeilen. Die Sache mit dem Select und einer folgenden Aktion kann man nämlich meist zusammenfassen.
Ich habe auch viele Kommentare eingefügt. Ist nicht verkehrt, zum einen für das Verständnis beim Programmieren, zum anderen, wenn Du in einem Jahr was ändern willst und da gleich siehst, wozu Du mal was programmiert hast.
Als rechte Spalte hab ich hier mal 55 gesetzt. Du hast die ja auch dynamisch ermittelt: Selection.End(xlToRight) Im Prinzip kann man das so  ähnlich umsetzen wie ich es bei der Zeile gemacht habe. Nur eben mit Right und Column ...

Code:

Sub Copy_Paste_Value_RP()
' Copy_Paste_Value_RP Makro
'
'Variablendeklarationen
'Long
Dim lRow As Long
'String
Dim strTreffer As String
   'Spalte C auswaehlen
   Columns("C:C").Select
   'Suchbegriff finden
   Selection.Find(What:="SAP_PLAN", After:=ActiveCell, LookIn:=xlFormulas, _
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
       MatchCase:=False, SearchFormat:=False).Activate
   strTreffer = ActiveCell.Address
   'Schleife ueber alle Treffer
   Do
     'Zeilennummer der aktiven Zelle feststellen
     lRow = ActiveCell.Row
     'Bereich ab Spalte E kopieren und unterhalb einfuegen
     Range(Cells(lRow, 5), Cells(lRow, 55)).Copy
     Cells(Cells(Rows.Count, 5).End(xlUp).Row + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
     'naechste Fundstelle suchen
     Selection.FindNext(After:=ActiveCell).Activate
   'Ende Schleife ueber alle Treffer, wenn erster Treffer wieder erreicht ist
   Loop Until ActiveCell.Address = strTreffer
End Sub

[schauan]

Hallo Dirk,

so läuft es.

Code:

Sub Andre_Copy_Paste_Value_RP()
' Copy_Paste_Value_RP Makro
'
'Variablendeklarationen
'Long
Dim lRow As Long
'String
Dim strTreffer As String
'Range
Dim rngCell As Range
  
   'In Spalte C Suchbegriff finden
   Columns("C:C").Find(What:="SAP_PLAN", After:=Cells(5, 3), LookIn:=xlFormulas, _
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
       MatchCase:=False, SearchFormat:=False).Activate
   strTreffer = ActiveCell.Address
   'Schleife ueber alle Treffer
   Do
     Set rngCell = ActiveCell
     'Zeilennummer der aktiven Zelle feststellen
     lRow = ActiveCell.Row
     'Bereich ab Spalte E kopieren und unterhalb einfuegen
     Range(Cells(lRow, 5), Cells(lRow, 55)).Copy
      'Cells(Selection.Row + 1, Selection.Column).Select
     Cells(Cells(Rows.Count, 5).End(xlUp).Row + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
     'naechste Fundstelle suchen
     'Selection.FindNext(After:=ActiveCell).Activate
     Columns("C:C").FindNext(After:=rngCell).Activate
        'Ende Schleife ueber alle Treffer, wenn erster Treffer wieder erreicht ist
   Loop Until ActiveCell.Address = strTreffer
End Sub

Durch die Kopieraktion hab ich die aktive Zelle nicht mehr in Spalte C gehabt und das war Hauptursache für den aufgelaufenen Fehler. Dazu hab ich die neue Variable rngCell eingeführt. Beim ersten Find habe ich die Zeilen gleich noch zusammengefasst und dadurch das Select rausbekommen.

[Gigbert62]

Durch die Kopieraktion hab ich die aktive Zelle nicht mehr in Spalte C gehabt und das war Hauptursache für den aufgelaufenen Fehler. Dazu hab ich die neue Variable rngCell eingeführt. Beim ersten Find habe ich die Zeilen gleich noch zusammengefasst und dadurch das Select rausbekommen.

Hi Andre,
prima, läuft durch wie Du gesagt hast. Die Daten werden alle unterhalb der letzten aktiven Zeile eingefügt.

Und ich denke jetzt fange ich an zu nerven, aber auf die Gefahr hin:
Bräuchte die kopierten Daten nicht unterhalb der letzten aktiven Zeile ,sondern jeweils unterhalb der gerade kopierten Zeile.

Also, als Beispiel, die kopierten Daten aus Zeile  "E10" - "AT10" sollten in die Zeile "E11"-"AT11".... die Daten aus "E18" - "AT18" in "E19" bis "AT19" kopiert werden, usw bis zum Ende...

Das jetzige Ergebnis kann ich aber mit Sicherheit auch gebrauchen, dafür also schon mal vielen Dank.

Wenn Du noch mal schauen willst wäre toll..

Beste Grüße
Dirk

[schauan]

Hallo Dirk,

Für die Zeilennummer ist dieser Code relevant:
Cells(Rows.Count, 5).End(xlUp).Row
Du tauschst den einfach durch die Variable lRow aus.

[Gigbert62]

Hallo Dirk,

Für die Zeilennummer ist dieser Code relevant:
Cells(Rows.Count, 5).End(xlUp).Row
Du tauschst den einfach durch die Variable lRow aus.

Hi Andre,
klappt, .... genial ... habe ne Menge gelernt... Herzlichen Dank für Deine Hilfe....
(wenn man das jetzt so sieht wird's auch klar(er).....  

Schönen Restsonntag noch ...
Besten Gruß .. Dirk

Code:

Sub Andre_Copy_Paste_Value_RP()
' Copy_Paste_Value_RP Makro
'
'Variablendeklarationen
'Long
Dim lRow As Long
'String
Dim strTreffer As String
'Range
Dim rngCell As Range
 
  'In Spalte C Suchbegriff finden
  Columns("C:C").Find(What:="SAP_PLAN", After:=Cells(5, 3), LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Activate
  strTreffer = ActiveCell.Address
  'Schleife ueber alle Treffer
  Do
    Set rngCell = ActiveCell
    'Zeilennummer der aktiven Zelle feststellen
    lRow = ActiveCell.Row
    'Bereich ab Spalte E kopieren (E-AT)
    Range(Cells(lRow, 5), Cells(lRow, 55)).Copy
     ' Hier werden die kopierten Daten nacheinander ans Ende der Datei kopiert
     'Cells(Cells(Rows.Count, 5).End(xlUp).Row + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     ' :=False, Transpose:=False
     ' Hier werden die Daten direkt in die darunterliegende Zeile kopiert
    Cells(lRow + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
    'naechste Fundstelle suchen
      Columns("C:C").FindNext(After:=rngCell).Activate
       'Ende Schleife ueber alle Treffer, wenn erster Treffer wieder erreicht ist
  Loop Until ActiveCell.Address = strTreffer
End Sub

[Gigbert62]

Hallo Dirk,

Für die Zeilennummer ist dieser Code relevant:
Cells(Rows.Count, 5).End(xlUp).Row
Du tauschst den einfach durch die Variable lRow aus.

Hi Andre,
klappt, .... genial ... habe ne Menge gelernt... Herzlichen Dank für Deine Hilfe....
(wenn man das jetzt so sieht wird's auch klar(er).....  

Schönen Restsonntag noch ...
Besten Gruß .. Dirk

Code:

Sub Andre_Copy_Paste_Value_RP()
' Copy_Paste_Value_RP Makro
'
'Variablendeklarationen
'Long
Dim lRow As Long
'String
Dim strTreffer As String
'Range
Dim rngCell As Range
 
  'In Spalte C Suchbegriff finden
  Columns("C:C").Find(What:="SAP_PLAN", After:=Cells(5, 3), LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Activate
  strTreffer = ActiveCell.Address
  'Schleife ueber alle Treffer
  Do
    Set rngCell = ActiveCell
    'Zeilennummer der aktiven Zelle feststellen
    lRow = ActiveCell.Row
    'Bereich ab Spalte E kopieren (E-AT)
    Range(Cells(lRow, 5), Cells(lRow, 55)).Copy
     ' Hier werden die kopierten Daten nacheinander ans Ende der Datei kopiert
     'Cells(Cells(Rows.Count, 5).End(xlUp).Row + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     ' :=False, Transpose:=False
     ' Hier werden die Daten direkt in die darunterliegende Zeile kopiert
    Cells(lRow + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
    'naechste Fundstelle suchen
      Columns("C:C").FindNext(After:=rngCell).Activate
       'Ende Schleife ueber alle Treffer, wenn erster Treffer wieder erreicht ist
  Loop Until ActiveCell.Address = strTreffer
End Sub

... Habe eben noch etwas gesehen was ich vorher nicht bedacht hatte ...
in dem zu kopierenden Bereich befindet sich eine Formel die ich mit kopieren muss.

Heisst:
von "5" bis "33" nur Werte kopieren, von "34" bis "35" die Formeln kopieren, von "36" bis "55" wieder nur Werte kopieren.

Bin selbst am versuchen habe es aber bisher nicht geschafft das auch noch hinzubekommen.....

Gruß und Dank
Dirk