DenizEmin

Danke für die Hilfe. Hab jetzt meinen VBA-Code soweit fertig. Hätte jemand ne Idee wie ich den noch kürzen könnte und wie ich es hinkrieg das er mir die Hintergrundfarbe in Stationen nicht ändert? Hier mal der Code: Sub Daten_vergleichen_über_2_Tabellenblätter() 'Variablen deklarieren Dim Suchname As String, Fundname As Range, letzte_Zeile_Tab_Mitarbeiter As Long, _ letzte_Zeile_Tab_Stationen As Long, Zeile_Mitarbeiter As Long, Addresse As String, _ gefundene_Zeile As Long, Zeile_Stationen As Long 'Bildschirmaktualisierung ausschalten Application.ScreenUpdating = False 'Letzte beschriebene Zeile in Blatt "Mitarbeiter" Spalte G ermitteln und 'in Variable "letzte_Zeile_Tab1" speichern letzte_Zeile_Tab_Mitarbeiter = Sheets("Mitarbeiter").Range("G65536").End(xlUp).Row 'Letzte beschriebene Zeile in Blatt "Stationen" Spalte E ermitteln und 'in Variable "letzte_Zeile_Tab2" speichern letzte_Zeile_Tab_Stationen = Sheets("Stationen").Range("E65536").End(xlUp).Row 'For/Next Schleife zum erfasse des Suchbegriffes in Blatt "Mitarbeiter" For Zeile_Mitarbeiter = 2 To letzte_Zeile_Tab_Mitarbeiter If Worksheets("Mitarbeiter").Cells(Zeile_Mitarbeiter, 7).Value <> Empty Then 'Den Namen aus der Zelle, die durch die For/Next Schleife angesprochen wird, 'auslesen und in Variable "Suchname" speichern Suchname = Sheets("Mitarbeiter").Cells(Zeile_Mitarbeiter, 7) 'Den Namen aus der Variablen "Suchname" mit dem Bereich E2:E letzte Zeile Tab2 'in Blatt "Stationen" vergleichen With Sheets("Stationen").Range("E2:E" & letzte_Zeile_Tab_Stationen) Set Fundname = .Find(What:=Suchname, LookIn:=xlValues) 'Wenn keine Übereinstimmung gefunden, dann... If Fundname Is Nothing Then '... Hintergrundfarbe der gefundenen Zelle in Blatt "Mitarbeiter" in 'Farbe grün ändern und... ' Sheets("Mitarbeiter").Cells(Wiederholungen, 7).Interior.ColorIndex = 4 '... Hintergrundfarbe der gefundenen Zelle in Blatt "Stationen" in 'Farbe grün ändern und... ' Sheets("Stationen").Cells(gefundene_Zeile, 5).Interior.ColorIndex = 4 '...den Suchnamen in Blatt "Mitarbeiter" kopieren und in Blatt '"Stationen" in die erste freie Zelle in Spalte E einfügen und... Sheets("Mitarbeiter").Cells(Zeile_Mitarbeiter, 7).Copy Sheets("Stationen").Cells(Sheets("Stationen").Range("E65536").End(xlUp). _ Offset(1, 5).Row, 5).PasteSpecial Paste:=xlValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Sheets("Mitarbeiter").Cells(Zeile_Mitarbeiter, 1).Copy Sheets("Stationen").Cells(Sheets("Stationen").Range("A65536").End(xlUp). _ Offset(1, 1).Row, 1).PasteSpecial Paste:=xlValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Sheets("Mitarbeiter").Cells(Zeile_Mitarbeiter, 6).Copy Sheets("Stationen").Cells(Sheets("Stationen").Range("B65536").End(xlUp). _ Offset(1, 2).Row, 2).PasteSpecial Paste:=xlValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Sheets("Mitarbeiter").Cells(Zeile_Mitarbeiter, 4).Copy Sheets("Stationen").Cells(Sheets("Stationen").Range("C65536").End(xlUp). _ Offset(1, 3).Row, 3).PasteSpecial Paste:=xlValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Sheets("Mitarbeiter").Cells(Zeile_Mitarbeiter, 5).Copy Sheets("Stationen").Cells(Sheets("Stationen").Range("D65536").End(xlUp). _ Offset(1, 4).Row, 4).PasteSpecial Paste:=xlValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Abfrage Ende End If End With End If 'Nächsten Schleifendurchlauf starten Next End Sub

Hi, es ist so, ich hab zwei Registerkarten die eine heißt Mitarbeiter die andere Stationen. Nun hab ich ein Button erstellt das mir bestimme Spalten von Mitarbeiter in bestimmte Spalten in Stationen kopiert. Mein Problem ist jetzt, wie schaff ich es, das wenn ich was in Stationen zusätzlich reinschreib dies nicht überschrieben wird, sonder bei der Einfügung der Daten von Mitarbeiter ab der nächsten leeren Zeile weitergemacht wird? Hier mal mein Code, den ich bis jetzt hab: Sub Schaltfläche10_Klicken() Dim summary As String Worksheets("Mitarbeiter").Range("A2:A2000").Copy Destination:=Worksheets("Stationen").Range("A2") Worksheets("Mitarbeiter").Range("F2:F2000").Copy Destination:=Worksheets("Stationen").Range("B2") Worksheets("Mitarbeiter").Range("D22000").Copy Destination:=Worksheets("Stationen").Range("C2") Worksheets("Mitarbeiter").Range("E2:E2000").Copy Destination:=Worksheets("Stationen").Range("D2") Worksheets("Mitarbeiter").Range("G2:G2000").Copy Destination:=Worksheets("Stationen").Range("E2") End Sub Wär für Eure Hilfe dankbar da ich echt mittlerweilen am verzweifeln bin! Gruß DenizEmin

Hat sich schon erledigt, habs rausgefunden!

Hallo Leute , bin fast am verzweifeln und wäre froh wenn Ihr mir helfen könntet. Also ich hab in Excel mehrere Register der eine heißt Mitarbeiter und der andere Stationen. Nun will ich das ein Button mir von Register Mitarbeiter A2:A693 ins Register Stationen A2:A693 kopiert. Ich denk für Euch ist es einfach aber da ich kaum oder sagen wir keine Erfahrung in VBA hab, dank ich Euch! Gruß Deniz

Hallo Leute, bin neu hier und hab gleich mal ein anliegen, wobei Ihr mir hoffentlich helfen könnt. Es ist so, mach grad ein Praktikum während meiner Ausbildung zum Infk. und mein Kollege bekam gestern einen Server. Diesen hat er im RAID1 Verbund eingestellt, beide 500Gb groß und ich sollte mit der ServerView Suite Software Windows Server 2008 installieren. Alles soweit kein Problem bis kurz vor schluß (wie es meist so ist ). Nun sagt mir der Server das zum Abschluß hierfür Firmen Daten verlangt werden und dies 30 min dauert. Ich klick auf weiter und er meint das mind. Anforderung 40GB, empfohlen 60GB sind, nun geht es nicht weiter und ich kann nur auf abbrechen klicken. Mein Arbeitskollege hat die Festplatte nicht partitioniert und nun bin ich mir nicht sicher ob ich in wieder Platt machen soll und in Partionieren soll. Hoffe auf Hilfe Eurer seits und Dank Euch schon mal.