Thema Datum  Von Nutzer Rating
Antwort
21.02.2017 10:27:37 Heiko
NotSolved
21.02.2017 12:18:40 Tutti
****
NotSolved
Rot Leere Zellen in Bereich löschen
 22.02.2017 08:31:32 Heiko
NotSolved

Ansicht des Beitrags:
Von:
Heiko		 Datum:
22.02.2017 08:31:32		 Views:
869		 Rating:
     
Antwort:
  Ja
Thema:
Leere Zellen in Bereich löschen

Hallo Tutti,

 

erstmal danke für die schnelle Antwort. Das ist nicht ganz das, was ich suche.

 

Mein Organigramm sieht quasi so aus:

(TL = Teamleiter, MA = Mitarbeiter des jeweiligen Teams)

Spalte A     Spalte B    Spalte C    ...

TL               TL             TL

(Leer)         (Leer)        (Leer)
MA1           (Leer)        (Leer)
(Leer)         MA 1         (Leer)
(Leer)         (Leer)        MA1
(Leer)         MA2          (Leer)
MA2           (Leer)        (Leer)

Der Code sieht folgendermaßen aus:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Sub CreateOrgChart()
 
    Dim i As Integer, j As Integer, y As Integer
    Dim LastRow As Long, LastLine As Long
         
 
    'Letzte Zeile in Spalte G (7) ermitteln
    With ActiveSheet
        LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row - 3
    End With
     
    'Bildschirmwechsel aus
    Application.ScreenUpdating = True
     
    'Zuweisung der Rollen
    Sheets(1).Select
     
     
    'Zuordnung der Mitarbeiter (MA) im Organigramm zu den jeweiligen Teamleitern
     
    Sheets(1).Select
    y = 14
    For i = 2 To LastRow
         
        If Sheets(1).Cells(i, 7).Value = "MA" And Sheets(1).Cells(i, 8).Value = "Volker Aichele" Then
        Range(Cells(i, 3), Cells(i, 4)).Copy
        Sheets(2).Cells(y + 1, 4).PasteSpecial Paste:=xlPasteValues <em><strong>'-->Fügt in Zeile ais "Kontakte" + y ein...</strong></em>
        End If
        If Sheets(1).Cells(i, 7).Value = "MA" And Sheets(1).Cells(i, 8).Value = "Marco Marquart" Then
        Range(Cells(i, 3), Cells(i, 4)).Copy
        Sheets(2).Cells(y + 1, 7).PasteSpecial Paste:=xlPasteValues
        End If
        If Sheets(1).Cells(i, 7).Value = "MA" And Sheets(1).Cells(i, 8).Value = "Daniel Leppert" Then
        Range(Cells(i, 3), Cells(i, 4)).Copy
        Sheets(2).Cells(y + 1, 10).PasteSpecial Paste:=xlPasteValues
        End If
        If Sheets(1).Cells(i, 7).Value = "MA" And Sheets(1).Cells(i, 8).Value = "Elena Weccard" Then
        Range(Cells(i, 3), Cells(i, 4)).Copy
        Sheets(2).Cells(y + 1, 13).PasteSpecial Paste:=xlPasteValues
        End If
        If Sheets(1).Cells(i, 7).Value = "MA" And Sheets(1).Cells(i, 8).Value = "Salvatore Oliverio" Then
        Range(Cells(i, 3), Cells(i, 4)).Copy
        Sheets(2).Cells(y + 1, 16).PasteSpecial Paste:=xlPasteValues
        End If
        If Sheets(1).Cells(i, 7).Value = "MA" And Sheets(1).Cells(i, 8).Value = "Giuseppe Oliverio" Then
        Range(Cells(i, 3), Cells(i, 4)).Copy
        Sheets(2).Cells(y + 1, 19).PasteSpecial Paste:=xlPasteValues
        End If
        If Sheets(1).Cells(i, 7).Value = "MA" And Sheets(1).Cells(i, 8).Value = "Dennis Pfeffer" Then
        Range(Cells(i, 3), Cells(i, 4)).Copy
        Sheets(2).Cells(y + 1, 22).PasteSpecial Paste:=xlPasteValues
        End If
        If Sheets(1).Cells(i, 7).Value = "MA" And Sheets(1).Cells(i, 8).Value = "Hauke Tiedemann" Then
        Range(Cells(i, 3), Cells(i, 4)).Copy
        Sheets(2).Cells(y + 1, 25).PasteSpecial Paste:=xlPasteValues
        End If
        y = y + 1
    Next i
End Sub

Ich habe somit NIE eine komplett leere Zeile, deshalb muss ich die einzelnen ZELLEN in der jeweiligen Spalte löschen...

Hab nach mehrfachem umstellen des Codes noch die Variante, dass er mir alles in eine Zeile schreibt und damit nur die jeweils letzten Mitarbeiter aus der Liste einträgt...

Hab mittlerweile ermmittelt:

Wenn in Tab1 ein MA in Zeilenummer 300 steht, wird dieser kopiert, der richtigen Spalte zugeordnet und in Zeile 300 + Y eingefügt (?)

Im Optimalfall sollte er die Mitarbeiter gleich so reinkopiert werden:

Spalte A     Spalte B    Spalte C    ...

TL               TL             TL

MA1           MA1          MA1
MA2           MA2          MA2
MA3           MA3          MA3
...                ...              ...

 

Ich krieg es bis dato nicht hin :(

Für eure Hilfe dankt,

Heiko

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
21.02.2017 10:27:37 Heiko
NotSolved
21.02.2017 12:18:40 Tutti
****
NotSolved
Rot Leere Zellen in Bereich löschen
 22.02.2017 08:31:32 Heiko
NotSolved