Daten aus Spalte auslesen und kopieren

[autostrada]

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

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

1

Abteilung

Name

Vorname

Funktion

Abteilung

Name

Vorname

Funktion

Abteilung

Name

Vorname

Funktion

Abteilung

Name

Vorname

Funktion

2

A

Wannemaker

Karin

Abteilungsleiter

B

Traugott

Kristin

Abteilungsleiter

C

Schmitz

Sven

Abteilungsleiter

D

Weber

Simone

Abteilungsleiter

3

A

Eichmann

Vanessa

Stellvertr. Abteilungsleiter

B

Wirth

Lucas

Stellvertr. Abteilungsleiter

C

Frueh

Swen

Stellvertr. Abteilungsleiter

D

Hahn

Jörg

Stellvertr. Abteilungsleiter

4

A

Vogel

Michael

Bürovorsteher

B

Thalberg

Brigitte

Bürovorsteher

C

Herrmann

Ralph

Bürovorsteher

D

Hahn

Ralph

Bürovorsteher

5

A

Fischer

Stephan

Angestellter

B

Braun

Sarah

Angestellter

C

Schulz

Jörg

Angestellter

D

Werner

Mario

Angestellter

6

A

Schuster

Katrin

Angestellter

B

Vogt

Dennis

Angestellter

C

Schultz

Martina

Angestellter

D

Weisz

Sabrina

Angestellter

7

A

Propst

Laura

Angestellter

B

Roth

Claudia

Angestellter

C

Eichmann

Stefanie

Angestellter

D

Beike

Maria

Angestellter

8

A

Schuster

Sara

Angestellter

B

Eichmann

Max

Angestellter

C

Wannemaker

Leonie

Angestellter

D

König

Laura

Angestellter

9

A

Mayer

Leah

Angestellter

B

Keller

Martina

Angestellter

C

Propst

Jana

Angestellter

D

Weisz

Thomas

Angestellter

10

A

Wolf

Martin

Angestellter

B

Wirth

Leonie

Angestellter

C

Traugott

Dirk

Angestellter

D

Ebersbacher

Jürgen

Angestellter

11

A

Decker

Phillipp

Angestellter

B

Schultz

Phillipp

Angestellter

C

Loewe

Anna

Angestellter

12

A

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...

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

[steve1da]

Hola,

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

[autostrada]

Mit mehreren Bedingungen meinte ich die verschiedenen Abteilungen...

[autostrada]

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

[Wastl]

Hi,

dein Beispiel hat 4 Abteilungen.
Bleibt es dabei?
oder können es auch 1000 sein?
Egal
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?

[autostrada]

Bekommst du das hin?

Eher nicht... 

[autostrada]

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...

[Wastl]

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