Makro zum Kopieren von Datensätzen

Sokrates66

Newbie
Registriert
Sep. 2013
Beiträge
2
Guten Morgen,

ich habe folgendes Problem und würde mich freuen, wenn Ihr mir hierbei behilflich sein könntet.

Ich benötige ein Makro, welches die Zeilen mit den erledigten Aufgaben aus dem Tabellenblatt "Maintenance" kopiert und in das Tabellenblatt "Erledigte Aufgaben" reinkopiert. Dabei müssen diese erledigten Zeilen ab der 8. Zeile im Tabellenblatt "Erledigte Aufgaben" untereinander gegliedert werden. Jede Woche werden neue Aufgaben im Tabellenblatt "Maintenance" definiert, Bei meinem Makro werden die Datensätze überschrieben, ich benötige aber den Befehl, damit das Makro die die letzte besetzte Zeile erkennt und diese an die Liste anhängt. Dadurch soll es halt möglich sein, welche Aufgaben bisher erledigt worden sind. Das Tabellenblatt Maintenance wird dabei wöchentlich neu gepflegt und dabei gehen ehemalige erledigte Aufgaben halt verloren.


Ich hoffe, dass ich mein Problem richtig schildern konnte. Dazu habe ich folgendes Makro geschrieben.





Sub Kopieren()
Dim rng As Range, i As Long, j As Long
Dim Zei As Long
Set rng = Range("A9:A100")

For i = 1 To 65536


With Sheets("Maintenance")
If .Cells(i, 19).Value = "x" Then
.Range(.Cells(i, 6), .Cells(i, 256)).Copy
j = j + 1
With Sheets("Erledigte Aufgaben").Cells(j + 8, 1)
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
End If

End With

Next

End Sub



Schöne Grüße
 
Das betreffende Sheet aktivieren.

Dim LastRow As Long

LastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
 
Schau mal, ob dir das weiter hilft. Musst du evtl noch etwas anspassen.


Sub Kopieren()
Dim letzteMaintenance As Integer
Dim letzteAufgabe As Integer

'letzte Zeile im Blatt Maintenance
letzteMaintenance = Worksheets("Maintenance").Cells(Rows.Count, 1).End(xlUp).Row
'letzte Zeile im Blatt Erledigte Aufgaben
letzteAufgabe = Worksheets("Erledigte Aufgaben").Cells(Rows.Count, 1).End(xlUp).Row

'MsgBox letzteMaintenance
'MsgBox letzteAufgabe

'so läuft nicht der Ganze Bereich durch
For i = 1 To letzteMaintenance


With Sheets("Maintenance")
If .Cells(i, 19).Value = "x" Then
.Range(.Cells(i, 6), .Cells(i, 256)).Copy

With Sheets("Erledigte Aufgaben").Cells(letzteAufgabe + 1, 1)
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
End If

End With

Next

End Sub
 
Funktioniert leider nicht. Es wird nur die 9. Zeile mit den Datensätzen überschrieben, die ein x in Spalte Status im Maintenance tabellenblatt haben.
Ergänzung ()

Mit dem Befehl von Deutes hat es funktioniert.

Vielen Dank. Auch dir vielen Dank Coldframe :)
Ergänzung ()

Wenn ich den Button ein zweites Mal betätige, werden die Datensätze logischerweise noch einmal übernommen. Kann man irgendwie vermeiden, dass die Datensätze doppelt vorkommen?


danke im voraus.

Gruß
 

Anhänge

  • problem.JPG
    problem.JPG
    163,3 KB · Aufrufe: 175
Du nimmst ja das "x" zum selektieren.
Jetzt könntest du am Schluss vom Makro, vor dem "next", das "x" durch etwas anderes ersetzen lassen, oder löschen.
 
Zurück
Oben