Microsoft Excel

Herbers Excel/VBA-Archiv

Wenn Werte ungleich dann kopieren

Betrifft: Wenn Werte ungleich dann kopieren von: Andy
Geschrieben am: 18.10.2020 17:54:01

Hallo zusammen,

ich möchte ein Projekt realisieren, wo ich Hilfe benötige.

In Spalte F stehen Buchstaben und Zahlen Kombinationen (Beispiele: ADR1, ADG7,...) . Nun möchte ich, dass jede beschriebene Zelle verglichen wird und für jeden unterschiedlichen Wert ein eigenes Tabellenblatt erstellt wird und die Zeilen A-F kopiert werden.

Ich hoffe das ist soweit verständlich.

Vielen Dank & VG
Andy

Betrifft: AW: Wenn Werte ungleich dann kopieren
von: Hajo_Zi
Geschrieben am: 18.10.2020 18:13:52

Hallo Andy,
Option Explicit

Sub Tabelle()
    Dim LoLetzte As Long
    Dim LoI As Long
    With ActiveSheet
        LoLetzte = IIf(IsEmpty(.Cells(Rows.Count, 6)), .Cells(Rows.Count, 6).End(xlUp).Row, _
            .Rows.Count)
        For LoI = 1 To LoLetzte
            If WorksheetFunction.CountIf(.Range("F1:F" & LoI), .Cells(LoI, 6)) = 1 _
                And .Cells(LoI, 6) <> "" Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = .Cells(LoI, 6)
                .Range("A" & LoI & ":F" & LoI).Copy Range("A" & _
                    WorksheetFunction.CountIf(.Range("F1:F" & LoI), .Cells(LoI, 6)))
            Else
                .Range("A" & LoI & ":F" & LoI).Copy Range("A" & _
                    WorksheetFunction.CountIf(.Range("F1:F" & LoI), .Cells(LoI, 6)))
            End If
        Next LoI
    End With
End Sub
Zu Deiner Datei kann ich nichts schreiben, was wohl daran liegt das ich nicht auf fremde Rechner schaue.Ich baue keine Datei nach.

Sollte die Datei verlinkt werden?

Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten
http://www.ms-office-forum.de/forum/showthread.php?t=322895
änderrn.

Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.

http://www.excel-ist-sexy.de/bilder-statt-datei/

Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.

Das ist nur meine Meinung zu dem Thema.

GrußformelHomepage

Betrifft: AW: Wenn Werte ungleich dann kopieren
von: Andy
Geschrieben am: 18.10.2020 18:37:42

Hallo Hajo,

ich bin echt begesitert. Danke für die sehr schnelle Hilfe. Du hast natürlich recht, dass es mit einer Datei besser ist.

Aber Deine Lösung ist schon sehr gut.

Super wäre nur nur noch, wenn ein Tabellenblatt mit dem Wert schon existiert, die Daten da angefügt werden und nicht ein neues Tabellenblatt erstellt wird.

Anbei die Testdatei. https://www.herber.de/bbs/user/140953.xlsx

LG
Andy

Betrifft: AW: Wenn Werte ungleich dann kopieren
von: Hajo_Zi
Geschrieben am: 18.10.2020 18:39:58

Hallo Andy,

ich kann Dir Leider nicht helfen, da bei mir eine XLSX Datei kein Makro enthält. Mein Makro ist also niucht da.
Da ich nicht für den Papierkorb arbeite bin ich raus.
Vierl Erfolg noch.

Gruß Hajo

Betrifft: AW: Wenn Werte ungleich dann kopieren
von: Andy
Geschrieben am: 18.10.2020 18:51:08

Hallo Hajo,

es ist verständlich, dass Du nicht für den Papierkorb arbeitest und es tut mir leid.
Ich schreibe heute zum ersten Mal hier, was mein fehlerhaftes nicht entschuldigen soll.

Vielleicht, kannst Du doch noch mal kurz schauen. Dein Makro ist auf Schaltfläche 1 gelegt.

https://www.herber.de/bbs/user/140954.xlsm

LG
Andy

Betrifft: AW: Wenn Werte ungleich dann kopieren
von: Andy
Geschrieben am: 18.10.2020 19:51:34

Es ist wirklich schade, dass es scheinbar nicht weitergeht.
Ich kann mich nur noch mal entschuldigen, dass ich meinen Thread nicht optimal gestartet habe und auch meine Antworten zu viel Platz für Speakulatuionen gelassen haben.

Dennoch möchte ich mich an der Stelle bei Hajo für die bisher geleistete Arbeit bedanken.

LG
Andy

Betrifft: AW: Wenn Werte ungleich dann kopieren
von: volti
Geschrieben am: 18.10.2020 19:55:47

Hallo Andy,

wenn ich das richtig verstanden habe, bringt Dich vielleicht dies hier weiter:


Code:
[Cc]
 
Option Explicit Sub Schaltfläche1_Klicken() Dim LoLetzte As Long, LoLetzte2 As Long Dim LoI As Long, WSh As Worksheet, iOfs As Integer Set WSh = ActiveSheet LoLetzte = IIf(IsEmpty(WSh.Cells(Rows.Count, 6)), WSh.Cells(Rows.Count, 6).End(xlUp).Row, _ WSh.Rows.Count) For LoI = 1 To LoLetzte On Error GoTo Fehler iOfs = 1 Sheets(WSh.Cells(LoI, 6).Value).Select On Error GoTo 0 LoLetzte2 = Cells(Rows.Count, 6).End(xlUp).Row + iOfs WSh.Range("A" & LoI & ":F" & LoI).Copy Range("A" & LoLetzte2) Next LoI Exit Sub Fehler: Sheets.Add(after:=Sheets(Sheets.Count)).Name = WSh.Cells(LoI, 6) iOfs = 0 Resume End Sub
 
____________________
viele Grüße aus Freigericht
Karl-Heinz


Betrifft: AW: Wenn Werte ungleich dann kopieren
von: Andy
Geschrieben am: 18.10.2020 20:04:57

Hallo Karl-Heinz,

perfekt. Das ist genau das was ich brauche.
Vielen Dank für Deine Hilfe.

Entschuldigt bitte die Unannehmlichkeiten, welche ich bereitet habe.

LG
Andy

Beiträge aus dem Excel-Forum zum Thema "Wenn Werte ungleich dann kopieren"