Office: Letze Zeile finden und kopieren

Hallo Zusammen,
habe mal wieder ein Problem mit einem Makro.
Ich möchte aus meinem Tab1 Werte von B5:B10 in Tab2 ?5:?10 kopieren/transponieren. Bis dahin kein Problem. Bevor er jedoch in Tab2 kopiert, soll er die letzte beschriebene Zelle finden und dann darunter kopieren, diese dann in der Farbe rot markieren und die Nummerierung aus Spalte A weiterführen.
Für die Suche der letzten Zelle habe ich
ActiveSheet.Cells(65536, 1).End(xlUp).Row gewählt. Diese findet er auch, nur leider fügt er mir nun nicht die kopierten Dinge ein.

Hier ein Teil des Makros

Sheets("Tab1").Select
Range("B5:B10").Select
Selection.Copy
Sheets("Tab2").Select
ActiveSheet.Cells(65536, 1).End(xlUp).Row
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("?:?").Select
Selection.Interior.ColorIndex = xlNone

Ich hoffe, es ist verständlich ausgedrückt. Wo ist der Fehler, oder was muss ich noch einfügen? Er bleibt halt bei >Selection.PasteSpecial Paste:=xlPasteAll usw. stehen.

hexlein

 

Hallo!

Irgendwie werde ich aus deiner Beschreibung nicht schlau...
Möchtest du nun kopieren oder transponieren?
Wo sollen die Werte hin?
Die Zellen sollen rot werden, aber du schreibst ColorIndex = xlNone ?
Welche Nummerierung aus Spalte A (welche Spalte A überhaupt)?

Als Ansatz hilft vielleicht dieser Code:
Er kopiert Tabelle1!B5:B10 unter die vorhandenen Werte in Tabelle2!A?:F?

Code:

Sub TransCopy()
Dim Ziel As Range, Quelle
Quelle = Sheets("Tabelle1").Range("B5:B10")
Set Ziel = Sheets("Tabelle2").Range("A65536").End(xlUp).Resize(1, 6).Offset(1, 0)
Ziel = WorksheetFunction.Transpose(Quelle)
End Sub

Rot hat übrigens den ColorIndex 3.

 

Hallo schatzi,

war übrigens noch der Code mit "weiß" ;-)
Ich möchte Kundendaten von Tab1 in Tab 2 übernehmen, jedoch sollen die Daten in Tab2 erst ab Spalte B beginnen, da in Spalte A eine fortlaufende Nummerierung ist.
Mit Deinem Code konnte ich das Problem schon lösen. Danke dafür.

Wie bekomme ich aber nun die laufende Nummerierung für die neu hinzugefügten in Spalte A hin?

Für Deine Hilfe bin ich Dir jetzt schon dankbar, habs nicht so mit den Makros.
hexlein

 

Hallo!

Spontan würde ich das per Formel machen:

=WENN(B7="";"";A6+1)

Oder spricht was dagegen?

 

Hallo schatzi,
an diese "einfache" Formel habe ich nicht gedacht, hatte etwas komplizierteres im Sinn, erfüllt aber seinen Zweck.
Vielen Dank mal wieder.
hexlein

 

Hallo schatzi,
vielleicht kannst Du mir ja noch mal helfen, irgendwie komme ich mit deinem wunderbarem Makro in einer neuen Tabelle nicht weiter, d.h. ich kann den Code einfach nicht so umschreiben, dass er funktioniert.
Diesmal möchte ich in der selben Tabelle die letzte beschriebene Zelle in Spalte B finden, dann eine Zeile darunter einfügen, diese grün markieren, beschreibbar machen, da die anderen Felder durch Zellenschutz gesperrt sind (Arbeitsmappenschutz lasse ich im Hintergrund aufheben, funktioniert.) Dann die Zeile darunter löschen. Fertig.

Problem: Da es ein Tourenplan ist und dieser nur auf einer Seite erscheinen soll, dürfen unter dem Tag, z.B. Montag, Dienstag etc. immer nur 8 Zeilen sein, Samstag und Sonntag nur jeweils 3 Zeilen, d.h. Zeile einfügen und löschen, max. 8/3 Zeilen, geht so etwas auch?

Für Deine wie immer super Lösungen schon mal vielen Dank.
hexlein

 

Hallo!

Der Code für dein Vorhaben könnte so aussehen:

Code:

Sub hexlein()
Dim Letzte As Range
'Letzte beschriebene Zelle bestimmen:
Set Letzte = Range("B65536").End(xlUp)
With Letzte.EntireRow
'Darunter eine Zeile einfügen:
.Offset(1, 0).Insert xlShiftDown
'Diese Zeile grün färben:
.Offset(1, 0).Interior.ColorIndex = 4
'Den Zellschutz aufheben:
.Offset(1, 0).Locked = False
'Die Zeile darunter löschen:
.Offset(2, 0).Delete xlShiftUp
End With
End Sub

Die Anzahl pro Datum müsstest du mit einem (bzw. zwei) "If...Then" oder "Select Case" abfragen, welches den obigen Code dann entweder ausführt oder überspringt.

 

Hallo schatzi,

leider läuft es nur bis
.Offset(1, 0).Locked = False, dann bleibt es hängen.

Wenn ich den Blattschutz aufhebe, läuft es.
Habe in Diese Arbeitsmappe den Befehl

Private Sub Workbook_Open()
'Worksheets("TP").Protect Password:="XXX", UserInterfaceOnly:=True
End Sub
Dann sollten doch eigentlich die Befehle laufen, oder?

Dann, wie kann ich bestimmen, dass nur von c bis e der neu eingefügten Zeile markiert wird und nicht die ganze Zeile?
Danke für die Hilfe
hexlein

P.S. Kannst Du mir mal einen Tip geben, welches Buch ich unbedingt brauche, um all diese tollen Sachen nachlesen zu können, damit ich das mal selber hinbekomme? :lol:

 

Hallo!

Ich hatte mich auf deine Aussage verlassen:

Dann müsstest du doch wissen wie's geht...

Code:

Sub hexlein()
Dim Letzte As Range

Sheets("TP").Unprotect Password:="XXX"

'Letzte beschriebene Zelle bestimmen:
Set Letzte = Range("B65536").End(xlUp)
With Letzte.EntireRow
'Darunter eine Zeile einfügen:
.Offset(1, 0).Insert xlShiftDown
'Diese Zeile grün färben:
.Offset(1, 0).Interior.ColorIndex = 4
'Den Zellschutz aufheben:
.Offset(1, 0).Locked = False
'Die Zeile darunter löschen:
.Offset(2, 0).Delete xlShiftUp
End With

Sheets("TP").Protect Password:="XXX", UserInterfaceOnly:=True

End Sub