Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Am Sonntag (23.09.) wird das Forum zwischen 06:00 Uhr und 09:00 Uhr kurzzeitig nicht erreichbar sein. Wir stellen auf SSL / HTTPS um.


Excel VBA Makro für Copy/paste
#1
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
Antwortento top
#2
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 Wink

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.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
[-] Folgende(r) 1 Benutzer sagt Danke an schauan für diesen Beitrag:
  • Gigbert62
Antwortento top
#3
(26.06.2015, 20:40)schauan schrieb: 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 Wink

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  Smile.

Dank für die Hilfe
Dirk


Angehängte Dateien
.xlsm   Excel_Macro_Copy_paste.xlsm (Größe: 32,84 KB / Downloads: 7)
Antwortento top
#4
Hallo Dirk,

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

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
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#5
Hi Andre,
habe deinen ersten Hinweis noch nicht eingesetzt da ich nichts zum einsetzen hatte Smile.

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


(27.06.2015, 05:28)schauan schrieb: Hallo Dirk,

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

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


Angehängte Dateien
.xlsm   Excel_Macro_Copy_paste.xlsm (Größe: 62,04 KB / Downloads: 4)
Antwortento top
#6
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.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#7
(28.06.2015, 17:34)schauan schrieb: 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
Antwortento top
#8
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.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#9
(28.06.2015, 18:45)schauan schrieb: 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).....  Smile

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
Antwortento top
#10
(28.06.2015, 20:06)Gigbert62 schrieb:
(28.06.2015, 18:45)schauan schrieb: 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).....  Smile

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
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste