Nummernzuordnung

[Jackie20004]

Vielen Dank :) ...allerdings verschiebt er auch das was drunter ist....ich verschiebe immer alles nach unten, wenn es oben ausgefüllt ist, kann man das irgendwie sperren??

[Gast 123]

Hallo

im Augenblick habe ich noch nicht verstanden was du damit konkret meinst??  Kannst du es mir an Hand eines Beispiel bitte noch mal genau erklaeren. Wenn ich es verstehe faellt mir bestimmt eine Lösung dazu ein.

mfg  Gast 123

[schauan]

Hallöchen,

da Dein Code mit den Änderungen aus #2 schon mal funktioniert hat würde ich auch mal dort weitermachen.

Du hast mit dem code

Code:

For Each Zelle In Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("D"))
   If Zelle = 1 Then

die komplette Spalte D abgedeckt.

Das könnte man auch anders als mit dem INTERSECT lösen. Ich mach's mir mal einfach und prüfe die Zeilennummer:

Code:

For Each Zelle In Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("D"))
   If Zelle = 1 And Zelle.Row >=8 Then

@Gast, Du schneidest die 3 letzten belegten Zellen aus und überschreibst damit 3 andere Zellen, wo in D eine 1 steht.
Es soll aber nur ein Name, also wahrscheinlich der Inhalt einer Zelle verschoben werden in die A-Zelle, wo daneben in D eine 1 steht.
Allerdings verschiebt der ursprüngliche Code auch nix sondern "kopiert" nur …

[Gast 123]

Hallo Schauan

da war ich wohl unaufmerksam, habe den Fehler nicht bemerkt. Schön das er dir aufgefallen ist.  Danke dafür.

mfg  Gast 123

[Jackie20004]

Hallo zusammen :)
erst einmal vielen Dank, das ihr Euch da Gedanken macht. Nun zur Erklärung, der Code von Gast123 funktioniert soweit schon, aber dabei ist nun folgendes Problem entstanden:
Nach der Zuordnung durch das Makro schiebe ich den ausgefüllten Part nach unten und hole mir den nächsten Abschnitt mit Namen wieder in die Liste und nun passiert folgendes...alles wird wild durcheinander gewürfelt sobald ich das Makro wieder bediene.
Deswegen kopiere ich hin und her um es dann später zu speichern....
lg Jackie

[Gast 123]

Hallo 

einerseits freut es mich das mein Makro grundsaetzlich funktioniert. Den Fehler mit hin und her kopieren würde ich gern noch beheben. Kannst du mir bitte noch mall eine Beispieldatei hochladen, aus der ich ersehen kann wie du das machst? Morgen habe ich aber keine Zeit, wichtiger Behördentermin. 

mfg  Gast 123

[Jackie20004]

Erst einmal vielen Dank, das du die Zeit nimmst, ich hoffe ich habe es in meiner Beispieldatei halbwegs genau erklärt!?

---

sorry vergessen...

[Gast 123]

Hallo

ich habe den Code noch mal überarbeitet, diesmal für normale For Next Schleife von 1 - lz4.  Der Code setzt voraus das alle Mitarbeiter in einem Block ab Zeile 9 stehen, und nur dieser Block zugeordnet werden soll!  Ansonsten müsste ich noch ein Makro schreiben um weitere Mitarbeiter unten anzuhaengen!  Ohne die vorherigen zu überschreiben!!  Die sollten dann auch nicht in Spalte A stehen, denn in Zeile 8 + 12 steht ja schon Josef und Maria.  

Ich warte mal ab ob MTA unten anhaengen erforderlich ist. Dann sollten die MTA aber besser in Spalte I,J,K stehen.

mfg  Gast 123

Code:

Sub Start_Gast_neu()
Dim lz1 As Long, z, i As Long
Dim lz4 As Long, Cnt As Integer
'LastCell in Spalte A + D ermitteln
lz1 = Cells(Rows.Count, 1).End(xlUp).Row
lz4 = Cells(Rows.Count, 4).End(xlUp).Row

'Cut Counter + 1. Cut Zeile fsetlegen
Cnt = lz1 - 8:  z = 9  '1. Cut Zeile!

'Vorwarts ausfüllen durch Cut Mitarbeiter
For i = 9 To lz4
 If Cells(i, 4) = 1 Then
    If Cells(z, 1) = Empty Then Exit For
    Cells(z, 1).Resize(Cnt, 3).Cut Cells(i, 1)
    z = i + 1  'letzte "1" in D merken  (i+1)
 End If
Next i
End Sub

mfg Gast 123

[Jackie20004]

Hi ,

sorry das ich mich erst jetzt melde, war leider etwas im Arbeitsstreß! Vielen Dank erst einmal für deine Geduld!
Habe es mal ausprobiert, aber das funkioniert leider noch nicht. Wenn ich die ersten zugeordneten runterschiebe, sollten die neuen quasi wieder geordnet und auch wieder runtergeschoben werden.
Jetzt zerhaut es leider wieder wenn oben zugeordnet wird. Die Tabellenzuordnung müßte aber auch so bleiben und dürfte nicht in andere Spalten versetzt werden.

lg Jackie