Hallo,

wo ist da dass Superproblem?

Leer Spalte vor A einfügen und Zelle B1 (gehe davon aus , dass die Daten do angeordnet sind) nach A2 verschieben und bis "Sabine" kopieren. Dann Zelle C1 in das nächste freie Feld verschieben. Als nächstes Spalte c, ab C2 bis letzen Namen unter Sabine schieben und jetzt Spalte A mit "Drucker 2" herunterkopieren. Gleiches mit Spalte d. Fertig.

Wenn das nicht passt solltest du dein Problem nochmal genauer erläutern.

Gruß

Helmut

Hallo und danke für die schnelle Antwort.
Das Problem liegt darin, dass es sich in Wirklichkeit um 186 Drucker und 900 User handelt.
Deswegen ist die "ziehen und kopieren"-Lösung nicht wirklich praktikabel.

Noch ne Idee

Danke für Infos.
Gruß Andi

Hi Andi,
folgenden Code in ein Modul kopieren:
2 Leere Spalten vor deiner ersten Spalte mit Daten einfügen.
Das Makro "Drucker" starten und schaun ob so ok ist.

Sub Drucker()
ls = Sheets(1).Cells(1, 256).End(xlToLeft).Column
For a = 3 To ls
lz1 = Sheets(1).Cells(65536, 1).End(xlUp).Row
lz2 = Sheets(1).Cells(65536, a).End(xlUp).Row
For b = 1 To lz2
Sheets(1).Cells(lz1 + b, 1).Value = Sheets(1).Cells(1, a).Value
Sheets(1).Cells(lz1 + b + 1, 2).Value = Sheets(1).Cells(b + 1, a).Value
Next
Next
End Sub

Gruß Niels

Hi, ich habs nun mal getestet aber es passiert rein gar nichts.
Ich habs in ein Modul kopiert und über Makro ausgeführt.
Es tut sich ausser einem kurz flackernden Mauszeiger nichts.
Noch ne Idee?

Danke, gruß Andi

Hallo Andi,

ich vermute mal, dass das Makro bei Dir nicht funktioniert, liegt daran, dass Deine Daten nicht im 1. Tabellenblatt stehen. Nils sein Code verweist aber auf das Tabellenblatt 1. Ob Nils sein Makro aber so funktioniert, habe ich nicht getestet.

ich habe Dir aber ein anderes Makro erstellt, das bei Dir funktionieren sollte. Hierbei wird ein neues Tabellenblatt angelegt, dass dann Deine Zusammengefassten Daten enthält. Kopiere es in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche.

[b]Option Explicit

Sub Zusammenfassen()
Dim iColumn As Integer, iRow As Integer
Dim i As Integer, FirstRow As Integer
Dim aktSheetName As String, StrColumn As String
aktSheetName = ActiveSheet.Name
For i = Worksheets.Count To 1 Step -1
If Sheets(i).Name = "Änderung" Then
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
Exit For
End If
Next
With Worksheets.Add
.Name = "Änderung"
End With
For iColumn = 1 To Sheets(aktSheetName).Range("IV1").End(xlToLeft).Column
StrColumn = Left(Cells(1, iColumn).Address(True, False), InStr(1, Cells(1, iColumn).Address(True, False), "$") - 1)
    For iRow = 2 To Sheets(aktSheetName).Range(StrColumn & "65536").End(xlUp).Row
        FirstRow = Sheets("Änderung").Range("A65536").End(xlUp).Offset(1, 0).Row
        Sheets("Änderung").Cells(FirstRow, 1) = _
        Sheets(aktSheetName).Cells(1, iColumn)
        Sheets("Änderung").Cells(FirstRow, 2) = _
        Sheets(aktSheetName).Cells(iRow, iColumn)
    Next
Next
End Sub[/b]

Ich hoffe, Du kommst klar. ´Bei Fragen melde Dich bitte.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 2 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo,
leider bin ich erst jetzt dazu gekommen, das Script zu testen.

Juuuhuuu :-) es funktioniert.

Vielen Dank dafür.

Danke, gruß Andi