4
VBA Transponierte Tabelle in passendes Tabellenblatt kopieren
Moin,
ich stehe gerade vor einem Problem. Ich habe 2 Listen.
Die erste sieht aus wie folgende:
Quelle:
Die zweite ist anders so transponiert aufgebaut, allerdings gibt es für jede Tierart ein eigenes Worksheet
Ziel:
Worksheet Hund:
Worksheet Katze:
Worksheet Maus:
Worksheet Ente:
Mein Ziel ist es, dass ich die Daten von der Quelle so transponiert in das richtige Worksheet in der Zeil-Arbeitsmatte kopiert bekomme. Das transponieren habe ich soweit auch hinbekommen.
Wie bekomme ich nun diese Daten entsprechend nach der Tierart in das richtige Tabellenblatt?
Danke und viele Grüße
Kalisser
ich stehe gerade vor einem Problem. Ich habe 2 Listen.
Die erste sieht aus wie folgende:
Quelle:
| Vorname | Name | Geschlecht | Tierart |
|---|---|---|---|
| Hans | Müller | m | Hund |
| Michi | Müller | m | Hund |
| Bibi | Haus | w | Katze |
| Achim | Amber | m | Maus |
| Donald | Duck | div | Ente |
| Daisy | Duck | w | Ente |
Die zweite ist anders so transponiert aufgebaut, allerdings gibt es für jede Tierart ein eigenes Worksheet
Worksheet Hund:
| Hans | Michi |
| Müller | Müller |
| m | m |
Worksheet Katze:
| Bibi |
| Haus |
| w |
Worksheet Maus:
| Achim |
| Amber |
| m |
Worksheet Ente:
| Donald | Daisy |
| Duck | Duck |
| m | w |
Mein Ziel ist es, dass ich die Daten von der Quelle so transponiert in das richtige Worksheet in der Zeil-Arbeitsmatte kopiert bekomme. Das transponieren habe ich soweit auch hinbekommen.
MyColl.Add "Vorname"
MyColl.Add "Name"
MyColl.Add "Geschlecht"
MyColl.Add "Tierart"
lastRow = Sheets("Quelle").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Worksheets("Quelle").Activate
'Für jeden Wert aus der Collection, suche den in Zelle A1. Wenn nicht, nehme nächsten aus der Collection
For i = 1 To MyColl.Count
For Each myIterator In MyColl
If Cells(1, i) = myIterator Then
Set myRng = Range(Cells(1, i), Cells(lastRow, i)).Columns
myRng.Columns.Copy
Worksheets("Temp").Cells(i, 1).PasteSpecial Transpose:=True
End If
Next
NextWie bekomme ich nun diese Daten entsprechend nach der Tierart in das richtige Tabellenblatt?
Danke und viele Grüße
Kalisser
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 629796
Url: https://administrator.de/contentid/629796
Ausgedruckt am: 24.11.2024 um 20:11 Uhr
4 Kommentare
Neuester Kommentar
Sub TransposeCopy()
On Error Resume Next
Dim shTarget As Worksheet, cell As Range, strArt As String
With ActiveSheet
For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
strArt = cell.Offset(0, 3).Value
Set shTarget = Sheets(strArt)
If Err.Number <> 0 Then
Set shTarget = Sheets.Add(After:=Sheets(Sheets.Count))
shTarget.Name = strArt
Err.Clear
End If
cell.Resize(1, 3).Copy
shTarget.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial Transpose:=True
Next
End With
End Sub
1
Vielen Dank primal! Das funktioniert schon mal super.
Ich war wahrschleich zu ungenau in meiner Formulierung.
Die Tierarten Hund, Katze, Maus, Ente gibts schon als Tabellenblatt in einer anderen Arbeitsmappe. Die Mappe heißt immer "Tier" und dann kann es vorkommen, dass dort eine laufende Nummer hinterlegt ist: Tiere (1) oder Tiere (7)...
Wenn man also beide Arbeitsmappen aufhat, würde ich gerne die Daten aus der Quelle (z.B., dass was jetzt als Ergebnis bei deinem Makro rauskommt) in die andere Ziel-Mappe, die schon die Arbeitsblätter enthält kopieren.
Wäre dann ja ähnlich wie
(Sehr falscher Pseudo-Code)
If Worksheet.Name von Mappe Quelle = Worksheet.Name von Ziel Then UsedRange.copy in Tiere.Worksheet(Tierart).paste
Ich war wahrschleich zu ungenau in meiner Formulierung.
Die Tierarten Hund, Katze, Maus, Ente gibts schon als Tabellenblatt in einer anderen Arbeitsmappe. Die Mappe heißt immer "Tier" und dann kann es vorkommen, dass dort eine laufende Nummer hinterlegt ist: Tiere (1) oder Tiere (7)...
Wenn man also beide Arbeitsmappen aufhat, würde ich gerne die Daten aus der Quelle (z.B., dass was jetzt als Ergebnis bei deinem Makro rauskommt) in die andere Ziel-Mappe, die schon die Arbeitsblätter enthält kopieren.
Wäre dann ja ähnlich wie
(Sehr falscher Pseudo-Code)
If Worksheet.Name von Mappe Quelle = Worksheet.Name von Ziel Then UsedRange.copy in Tiere.Worksheet(Tierart).paste
Kein Thema, einfach noch ein "Workbooks" vor die Sheets-Property packen
und Zeile 9 ebenfalls anpassen (für den Fall das es einen Tab tatsächlich noch nicht gibt, um diesen dann noch zu erstellen)
Set shTarget = Workbooks("Tier.xlsx").Sheets(strArt) Set shTarget = Workbooks("Tier.xlsx").Sheets.Add
Primal, ich danke dir aus tiefstem Herzen. Du hast mir sehr weitergeholfen. Schöne Festtage und einen guten Jahresabschluss 
Viele Grüße
Viele Grüße
