Transportieren

Forumthread: Transportieren

Transportieren

05.05.2014 18:43:44

Dieter.G

Hallo zusammen,
der Bereich D2:M2 in Tabelle1 ist mit Daten gefüllt. In Bereich B3:B32 befinden sich Namen im Bereich C3:C32 die dazugehörige Kundennummer. Wie kann ich mittels VBA erreichen, wenn im Bereich D2:M2 eine beliebige Zelle auswähle und sich in dieser Spalte bis Zeile 32 der Buchstabe "x" befindet der Name und die Kundennummer in Tabelle2 in Spalte A und B kopiert werden?
Vielleicht ist mein Anliegen in der angehängten Beispieldatei besser zu verstehen.
https://www.herber.de/bbs/user/90501.xlsx
Vielen Dank im Voraus,
Gruß Dieter

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Transportieren

05.05.2014 19:20:37

Matthias
statt "A:B" sollte es natürl. "B:C" heißen kwT

05.05.2014 19:25:35

Matthias
Nicht nötig; 'Transportieren' kann man nur ...

05.05.2014 19:20:54

Luc:-?
definierte Daten übertragen

05.05.2014 19:26:39

Beverly
Danke!

05.05.2014 20:01:58

Dieter.G

AW: Transportieren

05.05.2014 19:20:37

Matthias

Hallo
Zum Einen kann man das per Filter ohne VBA lösen.

Text 1

Text 2

Text 3

Text 4

Text 5

Text 6

Text 7

Text 8

Text 9

Text 10

Name 5

005

Name 13

013

Name 22

022

Name 28

028

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Jetzt einfach den gefilterten Bereich in "A:B" kopieren und in die Zieltabelle einfügen.

Zum Anderen gehts natürlich auch mit VBA
Hier mal eine Variante
https://www.herber.de/bbs/user/90502.xlsm
Gruß Matthias

statt "A:B" sollte es natürl. "B:C" heißen kwT

05.05.2014 19:25:35

Matthias

Nicht nötig; 'Transportieren' kann man nur ...

05.05.2014 19:20:54

Luc:-?

…per VBA, Dieter;
so, wie du dein Anliegen beschreibst, käme dafür das Worksheet_SelectionChange-Ereignis infrage. Lies dazu mal in der VBEditor-Hilfe nach!
Gruß Luc :-?

definierte Daten übertragen

05.05.2014 19:26:39

Beverly

Hi Dieter,
ich würde das Doppelklick-Ereignis im Bereich D2:M2 benutzen um die Daten zu übertragen:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim rngZelle As Range Dim lngZaehler As Long Dim arrDaten() Dim strStart As String If Not Intersect(Target, Range("D2:M2")) Is Nothing Then Cancel = True If Application.CountIf(Columns(Target.Column), "x") > 0 Then lngZaehler = Application.CountIf(Columns(Target.Column), "x") - 1 ReDim arrDaten(0 To lngZaehler, 0 To 1) Set rngZelle = Columns(Target.Column).Find("x", lookat:=xlWhole) strStart = rngZelle.Address lngZaehler = 0 Do arrDaten(lngZaehler, 0) = Cells(rngZelle.Row, 2) arrDaten(lngZaehler, 1) = Cells(rngZelle.Row, 3) lngZaehler = lngZaehler + 1 Set rngZelle = Columns(Target.Column).FindNext(rngZelle) Loop While Not rngZelle Is Nothing And strStart rngZelle.Address Worksheets("Tabelle2").Range("A1").Resize(UBound(arrDaten(), 1) + 1, 2) = arrDaten() Set rngZelle = Nothing End If End If End Sub https://www.herber.de/bbs/user/90503.xlsm

Danke!

05.05.2014 20:01:58

Dieter.G

Vielen Dank für Eure Mühe!
Genau danach habe ich gesucht.
Gruß Dieter

Beliebteste Forumthreads (12 Monate)

Forumthread: Transportieren

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

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread