Clever-Excel-Forum

Hallo zusammen,

ich möchte aus einer mehrspaltigen Tabelle bestimmte Werte herauskopieren und in einer anderen Tabelle einfügen.
Das ist die Ausgangstabelle:
Tabelle4

	A	B	C	D
1	Abteilung	Name	Vorname	Funktion
2	A	Wannemaker	Karin	Abteilungsleiter
3	A	Eichmann	Vanessa	Stellvertretender Abteilungsleiter
4	A	Vogel	Michael	Bürovorsteher
5	A	Fischer	Stephan	Angestellter
6	A	Schuster	Katrin	Angestellter
7	A	Propst	Laura	Angestellter
8	A	Schuster	Sara	Angestellter
9	A	Mayer	Leah	Angestellter
10	A	Wolf	Martin	Angestellter
11	A	Decker	Phillipp	Angestellter
12	A	Mauer	Jens	Angestellter
13	B	Traugott	Kristin	Abteilungsleiter
14	B	Wirth	Lucas	Stellvertretender Abteilungsleiter
15	B	Thalberg	Brigitte	Bürovorsteher
16	B	Braun	Sarah	Angestellter
17	B	Vogt	Dennis	Angestellter
18	B	Roth	Claudia	Angestellter
19	B	Eichmann	Max	Angestellter
20	B	Keller	Martina	Angestellter
21	B	Wirth	Leonie	Angestellter
22	B	Schultz	Phillipp	Angestellter
23	C	Schmitz	Sven	Abteilungsleiter
24	C	Frueh	Swen	Stellvertretender Abteilungsleiter
25	C	Herrmann	Ralph	Bürovorsteher
26	C	Schulz	Jörg	Angestellter
27	C	Schultz	Martina	Angestellter
28	C	Eichmann	Stefanie	Angestellter
29	C	Wannemaker	Leonie	Angestellter
30	C	Propst	Jana	Angestellter
31	C	Traugott	Dirk	Angestellter
32	C	Loewe	Anna	Angestellter
33	D	Weber	Simone	Abteilungsleiter
34	D	Hahn	Jörg	Stellvertretender Abteilungsleiter
35	D	Hahn	Ralph	Bürovorsteher
36	D	Werner	Mario	Angestellter
37	D	Weisz	Sabrina	Angestellter
38	D	Beike	Maria	Angestellter
39	D	König	Laura	Angestellter
40	D	Weisz	Thomas	Angestellter
41	D	Ebersbacher	Jürgen	Angestellter

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Nun sollen alle Abteilung mit den dazu gehörenden Mitarbeitern in einem anderen Blatt nebeneinander dargestellt werden:
Tabelle5

Abteilung

Name

Vorname

Funktion

Abteilung

Name

Vorname

Funktion

Abteilung

Name

Vorname

Funktion

Abteilung

Name

Vorname

Funktion

Wannemaker

Karin

Abteilungsleiter

Traugott

Kristin

Abteilungsleiter

Schmitz

Sven

Abteilungsleiter

Weber

Simone

Abteilungsleiter

Eichmann

Vanessa

Stellvertr. Abteilungsleiter

Wirth

Lucas

Stellvertr. Abteilungsleiter

Frueh

Swen

Stellvertr. Abteilungsleiter

Hahn

Jörg

Stellvertr. Abteilungsleiter

Vogel

Michael

Bürovorsteher

Thalberg

Brigitte

Bürovorsteher

Herrmann

Ralph

Bürovorsteher

Hahn

Ralph

Bürovorsteher

Fischer

Stephan

Angestellter

Braun

Sarah

Angestellter

Schulz

Jörg

Angestellter

Werner

Mario

Angestellter

Schuster

Katrin

Angestellter

Vogt

Dennis

Angestellter

Schultz

Martina

Angestellter

Weisz

Sabrina

Angestellter

Propst

Laura

Angestellter

Roth

Claudia

Angestellter

Eichmann

Stefanie

Angestellter

Beike

Maria

Angestellter

Schuster

Sara

Angestellter

Eichmann

Max

Angestellter

Wannemaker

Leonie

Angestellter

König

Laura

Angestellter

Mayer

Leah

Angestellter

Keller

Martina

Angestellter

Propst

Jana

Angestellter

Weisz

Thomas

Angestellter

Wolf

Martin

Angestellter

Wirth

Leonie

Angestellter

Traugott

Dirk

Angestellter

Ebersbacher

Jürgen

Angestellter

Decker

Phillipp

Angestellter

Schultz

Phillipp

Angestellter

Loewe

Anna

Angestellter

Mauer

Jens

Angestellter

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Meine Versuche mit Schleifen zu arbeiten scheitern bisher daran, dass es mehrere Bedingungen gibt, die zu Erfüllen sind. Ich komme irgendwie nicht dahinter...

Ich bin für jede Hilfe dankbar... Smile

P.S. Die Namen in der Liste sind aus einer Fake-Liste entnommen und nicht real. Zufällige Namensgleichheiten bitte ich zu entschuldigen...

Gruss

Rolf

Hola,

Zitat:dass es mehrere Bedingungen gibt, die zu Erfüllen sind

ich sehe nur eine, die Abteilung in Spalte A. Welche gibt es denn noch?

Gruß,
steve1da

Mit mehreren Bedingungen meinte ich die verschiedenen Abteilungen...

Hat jemand eine Idee wie ich das bewerkstelligen kann?
Die Mitarbeiter jeder Abteilung sollen abteilungsweise ausgelesen und dann in ein anderes Tabellenblatt nebeneinander eingefügt werden.
Die Mitarbeiter in ein anderes Tabellenblatt untereinander zu bekommen, das klappt. Mir fehlt nur der Hinweis, wie ich die zu einer anderen
Abteilung gehörenden Mitarbeiter nebeneinander anordnen kann.
Hier der Code, der die Mitarbeiter untereinander anordnet...

Edit: Der Fehler, bzw. die Crux liegt vermutlich in der Destination-Anweisung...

Code:
Sub kopieren()

Dim x As Long

Dim y As Long

y = 2

lastrow = Cells(Rows.Count, 1).End(xlUp).Row

For x = 2 To lastrow

If Cells(x, 1) = "A" Then

Rows(x).Copy Destination:=Tabelle6.Rows(y)

y = y + 1

Else

End If

If Cells(x, 1) = "B" Then

Rows(x).Copy Destination:=Tabelle6.Rows(y)

y = y + 1

Else

End If

If Cells(x, 1) = "C" Then

Rows(x).Copy Destination:=Tabelle6.Rows(y)

y = y + 1

Else

End If

If Cells(x, 1) = "D" Then

Rows(x).Copy Destination:=Tabelle6.Rows(y)

y = y + 1

Else

End If

Next

End Sub

Hi,

dein Beispiel hat 4 Abteilungen.
Bleibt es dabei?
oder können es auch 1000 sein?
Egal Undecided

Normalerweise kopiert man in VBA nicht Bereiche, sondern füllt sie direkt nach dem Schema:
rechts befüllt links
Also
Zieltabelle.ZielZelle = Quelltabelle.QuellZelle

Du läufst mit einer Schleife von Oben bis unten durch.
Wenn sich die Abteilungsbezeichnung ändert, erhöhst du die Spalte um 4 und setzst Zeile wieder auf Anfang.
Bekommst du das hin?

Zitat:Bekommst du das hin?

Eher nicht... Huh

Da ich es bislang selbst nicht hinbekommen habe und mir hier scheinbar niemand helfen kann oder zumindest mal einen Anstoß in die richtige Richtung geben kann (will),
werde ich eben anderweitig versuchen eine Lösung zu finden.

Schade eigentlich...

Hallo autostrada,

Sorry, hatte Wochenende und Real-Leben.
Vielen Dank, dass du zumindest 1 meiner Fragen beantwortet hast.

genau auf dein Beispiel zugeschnitten der Code, der bei mir funktioniert:
Er kopiert es in ein neues Tabellenblatt

Code:
Option Explicit

Sub autostrada()

Dim Abteilung_Lang

Dim intLauf1 As Integer

Dim intLauf2 As Integer

Dim intSpalte

Dim neublatt

Dim Quelle

Quelle = ActiveSheet.Name

Sheets.Add

neublatt = ActiveSheet.Name

'Sheets(Quelle).Activate

Abteilung_Lang = Sheets(Quelle).Range("A1: D41")

intLauf2 = 1

intSpalte = 1

For intLauf1 = 1 To 41

    If intLauf1 = 1 Then

            Sheets(neublatt).Cells(intLauf2, intSpalte) = Abteilung_Lang(intLauf1, 1)

            Sheets(neublatt).Cells(intLauf2, intSpalte + 1) = Abteilung_Lang(intLauf1, 2)

            Sheets(neublatt).Cells(intLauf2, intSpalte + 2) = Abteilung_Lang(intLauf1, 3)

            Sheets(neublatt).Cells(intLauf2, intSpalte + 3) = Abteilung_Lang(intLauf1, 4)

            intLauf2 = intLauf2 + 1

    ElseIf Abteilung_Lang(intLauf1, 1) <> Abteilung_Lang(intLauf1 - 1, 1) And intLauf1 > 2 Then

            intSpalte = intSpalte + 4

            intLauf2 = 1

            ' Überschrift

            If intLauf2 = 1 Then

                Sheets(neublatt).Cells(intLauf2, intSpalte) = Abteilung_Lang(1, 1)

                Sheets(neublatt).Cells(intLauf2, intSpalte + 1) = Abteilung_Lang(1, 2)

                Sheets(neublatt).Cells(intLauf2, intSpalte + 2) = Abteilung_Lang(1, 3)

                Sheets(neublatt).Cells(intLauf2, intSpalte + 3) = Abteilung_Lang(1, 4)

                intLauf2 = intLauf2 + 1

            Else

            ' Kollegen

            Sheets(neublatt).Cells(intLauf2, intSpalte) = Abteilung_Lang(intLauf1, 1)

            Sheets(neublatt).Cells(intLauf2, intSpalte + 1) = Abteilung_Lang(intLauf1, 2)

            Sheets(neublatt).Cells(intLauf2, intSpalte + 2) = Abteilung_Lang(intLauf1, 3)

            Sheets(neublatt).Cells(intLauf2, intSpalte + 3) = Abteilung_Lang(intLauf1, 4)

            intLauf2 = intLauf2 + 1

            End If

    Else

            Sheets(neublatt).Cells(intLauf2, intSpalte) = Abteilung_Lang(intLauf1, 1)

            Sheets(neublatt).Cells(intLauf2, intSpalte + 1) = Abteilung_Lang(intLauf1, 2)

            Sheets(neublatt).Cells(intLauf2, intSpalte + 2) = Abteilung_Lang(intLauf1, 3)

            Sheets(neublatt).Cells(intLauf2, intSpalte + 3) = Abteilung_Lang(intLauf1, 4)

            intLauf2 = intLauf2 + 1

    End If

Next

End Sub

autostrada

steve1da

autostrada

autostrada

Wastl

autostrada

autostrada

Wastl