Herbers Excel-Forum - das Archiv

Werte zusammenfügen

Bild

Betrifft: Werte zusammenfügen
von: FritzF

Geschrieben am: 17.12.2006 16:09:26
Hallo Excelgemeinde
Ich möchte Werte aus 2 Sheets in ein drittes Sheet kopieren und leider mit VBA nein, stehe ich am Berg.
Hier noch die Beispieldatei:
https://www.herber.de/bbs/user/39068.xls
Das ganze sollte so Funktionieren, dass aus den beiden Sheets "Main" und "Zubehör" die Struktur im Sheet "Ausgabe" ensteht.
Also als erstes soll der erste Wert in der Spalte A vom Sheet "Main" in die Spalte A vom Sheet "Ausgabe" kopiert werden. Dann müssen die Werte im Sheet "Zubehör" entsprechend dem Wert in der Spalte A vom Sheet "Ausgabe" in die Spalte B vom Sheet "Ausgabe" kopiert werden.
Danach den zweiten Wert vom Sheet "Main" ins Sheet "Ausgabe" kopieren etc.
und es soll dann immer noch eine Zeile ausgelassen werden im Scheet "Ausgabe" für den nächsten Eintrag.
Besten Dank zum voraus für Feedback
Die besten Grüsse
FritzF
Bild

Betrifft: AW: Werte zusammenfügen
von: fcs

Geschrieben am: 17.12.2006 17:05:13
Hallo Fritz,
nachfolgende Prozedur bewerkstellig die Umgruppierung. Prozedur im VBA-Editor in ein Modul der Datei kopieren. Falls erforderlich vorher ein Modul einfügen.
Gruss
Franz
Sub Daten_Umgruppieren()
Dim wb As Workbook
Dim wksMain As Worksheet, wksZub As Worksheet, wksAus As Worksheet
Dim rngModell As Range, rngZiel As Range, ZeileAus As Long, I As Integer, SpMax As Integer
Dim Modell As Variant
Set wb = ActiveWorkbook
Set wksMain = wb.Worksheets("Main")
Set wksZub = wb.Worksheets("Zubehör")
Set wksAus = wb.Worksheets("Ausgabe")
ZeileAus = 83 '1. Zeile im Blatt Ausgabe in die Daten eingetragen werden sollen
With wksZub
'Bereich mit Typnamen in Spalte A Blatt Zubehör
Set rngModell = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
'letzte Spalte mit Daten  in Zeile 1
SpMax = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
For Zeile = 2 To wksMain.Cells(wksMain.Rows.Count, "A").End(xlUp).Row
Modell = wksMain.Cells(Zeile, "A")
wksAus.Cells(ZeileAus, "A") = Modell
Set rngZiel = rngModell.Find(Modell)
If rngZiel Is Nothing Then
MsgBox "Das Modell. " & Modell & " wurde im Zubehör nicht gefunden"
Else
For I = 1 To SpMax - 1
If Not IsEmpty(rngZiel.Offset(0, I)) Then
ZeileAus = ZeileAus + 1
wksAus.Cells(ZeileAus, "B") = rngZiel.Offset(0, I)
End If
Next I
End If
ZeileAus = ZeileAus + 2
Next Zeile
End Sub

Bild

Betrifft: AW: Werte zusammenfügen
von: FritzF

Geschrieben am: 17.12.2006 17:12:10
Hallo Franz
Absolute Spitzenklasse, exakt genau das brauche ich :-)
Vielen Dank für deinen tollen Service.
Ich wünsche Dir noch einen schönen Sonntag abend
Die besten Grüsse
Fritz
 Bild