Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1700to1704
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: verschiedene MehrfachWerte in verschiedene AB

VBA: verschiedene MehrfachWerte in verschiedene AB
10.07.2019 15:02:26
Cirby
Hallo zusammen,
ich habe an folgender Aufgabe zu nagen.
Schritt 1: Ich habe eine Ausgangstabelle(Name=Verteilung) und möchte für jeden Wert aus Spalte A (ab Zeile 2) ein neues Arbeitsblatt anlegen, insofern der Wert erstmalig auftritt.
Dieses AB benenne ich dann mit Cell + dem Zellenwert.
Zudem Füge ich dabei jeweils die Überschrift ein, indem ich aus der Ausgangstabelle die ersten Werte der Spalten E,F und H in das neu erstellte AB kopiere.
Soweit so gut. Das funktioniert schon prima! Dazu ist auch der Code unten aufgeführt.
Schritt 2: Nun mein Problem. Ich möchte zusätzlich die Werte aus den Spalten E, F und H aus den Zeilen die in Schritt 1 durchgegangen werden in das richtige AB in Spalte A, B und C in die erste freie Zeile kopieren. Dabei kommen aber die gleichen Werte in Spalte A mehrfach vor. Es muss jedoch dann das richtige AB angesteuert werden, welches ich schon in Schritt 1 erstellt habe.
Ich hoffe mir kann jmd bei dieser Herausforderung helfen! :) Danke!
Gruß Cirby
Bisheriger Code:
Sub ArbeitsblätterÖffnenUndÜberschriftenEinfügen()
Dim rngZelle    As Range, _
rngBereich  As Range, _
wb          As Workbook
Dim i2 As Integer
Dim iIndex As Integer
Dim Bool As Boolean
Set wb = ThisWorkbook
Set rngBereich = wb.Sheets("Verteilung").Range("A2:A10000")
iIndex = wb.Sheets("Verteilung").Index
For Each rngZelle In rngBereich
For i2 = 1 To Worksheets.Count
If Worksheets(i2).Name = "Cell" & rngZelle.Value Then
Bool = True
Exit For
Else
Bool = False
End If
Next i2
'neue Arbeitsblätter mit Zellenbezeichnung versehen und Überschriften eintragen
If Bool = False Then
If rngZelle  "" Then
wb.Sheets.Add after:=wb.Sheets(iIndex)
iIndex = iIndex + 1
ActiveSheet.Name = "Cell" & rngZelle.Value
With Worksheets("Verteilung")
.Cells(rngZelle.Column, 5).Copy
ActiveSheet.Range("A1").PasteSpecial xlPasteValues
.Cells(rngZelle.Column, 6).Copy
ActiveSheet.Range("B1").PasteSpecial xlPasteValues
.Cells(rngZelle.Column, 8).Copy
ActiveSheet.Range("C1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
End If
End If
Next rngZelle
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ansatz
10.07.2019 15:37:15
Fennek
Hallo,
teste mal mit diesem Code für 1. UND 2.

Sub F_en()
Dim Sht As Worksheet
On Error Resume Next
With Sheets("Verteilung")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print i, .Cells(i, 1)
Set Sht = Sheets(.Cells(i, 1).Text)
If Err.Number  0 Then
Debug.Print Err.Number
Set Sht = Sheets.Add(, Sheets(Sheets.Count))
Sht.Name = .Cells(i, 1)
With .Cells(1, 1).CurrentRegion
.AutoFilter 1, .Cells(i, 1)
.Copy Sht.Range("A1")
.AutoFilter
End With
End If
Err.Clear
Next i
End With
End Sub
mfg
AW: VBA: verschiedene MehrfachWerte in verschiedene AB
10.07.2019 16:26:08
Cirby
Hallo,
Vielen Dank! Es werden die Tabellen mit den richtigen Werten erstellt.
3 Sachen fehlen jedoch:
1. Die neu erstellten Tabellenblätter haben nicht den Namen "Cell" + aktueller Tabellenname
2. alle Spalten bis auf E,F und H müssen auf den neuen Tabellenblättern gelöscht werden
3. die übrigen 3 Spalten ausschneiden und in Spalte A,B und C einfügen
Danke für die Hilfe! :)
Gruß
Anzeige
AW: Na dann mach mal!
10.07.2019 16:36:37
Fennek
oder suche dir einen Dienstleister
AW: Na dann mach mal!
14.07.2019 13:49:46
Hajo_Zi
lasse den Fragesteller entscheiden ob offen.
Es ist heute nicht mehr üblich eine Rückmeldung zu geben und so ist der Beitrag über 6 Tage offen.

AW: Na dann mach mal
15.07.2019 11:10:01
Cirby
Hallo Fenek,
da habe ich mich wohl unhöflch ausgedrückt. Das war so nicht meine Absicht. Entschuldigung!
Ich konnte mit deinem Ansatz meine Fragen lösen, allerdings habe ich ein anderes Problem bei dem ich nicht vorankomme und würde mich über Hilfe freuen.
Aktuell ist es so das er ein neues Tabellenblatt mit Name Cell2 öffnet, jedoch übergeht er nicht die Zeilen die auch den Wert Cell2 haben und so wird nun für jede Zeile ein Tabellenblatt geöffnet. Obwohl ein Tabellenblatt pro Wert reichen würde.
Anbei der ergänzte Code:

Sub F_en()
Dim i As Integer
Dim Sht As Worksheet
On Error Resume Next
With Sheets("Verteilung")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print i, .Cells(i, 1)
Set Sht = Sheets(.Cells(i, 1).Text)
If Err.Number  0 Then
Sht.Name = .Cells(i, 22)
Debug.Print Err.Number
Set Sht = Sheets.Add(, Sheets(Sheets.Count))
Range("A:A").Copy Range("V:V")
Sht.Name = .Cells(i, 22)
With .Cells(1, 1).CurrentRegion
.AutoFilter 1, .Cells(i, 1)
.Copy Sht.Range("A1")
.AutoFilter
ActiveSheet.Name = "Cell" & Range("A2").Value
ActiveSheet.Columns("A:D").Delete
ActiveSheet.Columns("C:C").Delete
ActiveSheet.Columns("D:Q").Delete
End With
End If
Err.Clear
Next i
End With
End Sub


Ein Tipp/Hilfe würde mich freuen! Vielen Dank!
Mit freundlichen Grüßen
Cirby
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige