Übertragen

Forumthread: Übertragen

Übertragen

22.11.2006 07:25:37

Hugo

Guten Morgen Excel-Profis
Weiss jemand wie ich folgendes fertig bringe?:
Ich möchte meine Datei so einrichten, dass sämtliche Einträge in der Spalte C in ein neues Tabellenblatt übertragen werden, wenn jeweils in der gleichen Zeile in der Spalte A ein Eintrag besteht. (ohne Pivot-Tabelle)
Gruss
Hugo

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Find-Function

22.11.2006 08:03:53

xlSchnack
AW: Find-Function

22.11.2006 08:25:54

Hugo
AW: Find-Function

22.11.2006 11:26:30

xlSchnack
Alternative mit Formel-Code

22.11.2006 12:08:44

xlSchnack

Find-Function

22.11.2006 08:03:53

xlSchnack

Hi Hugo,
Quelltabelle ist Tabelle1 - Zieltabelle ist Tabelle2 (muss schon angelegt sein):


Sub Finden_und_uebertragen()
Dim wksQuell As Worksheet
Dim wksZiel As Worksheet
Dim lngRow As Long
Dim rngSuchBereich As Range
Dim firstAddress As String
Dim C As Range
Set wksQuell = Worksheets("Tabelle1") 'Quellblatt
Set wksZiel = Worksheets("Tabelle2") 'Zielblatt
Set rngSuchBereich = wksQuell.Range("A:A") 'Suchbereich im Quellblatt
lngRow = 1 'Startzeile im Zielblatt festlegen
wksZiel.Cells.ClearContents 'Zielblatt komplett löschen
With rngSuchBereich
Set C = .Find("*", lookat:=xlWhole)
If Not C Is Nothing Then
firstAddress = C.Address
Do
wksZiel.Rows(lngRow).Value = Rows(C.Row).Value
lngRow = lngRow + 1
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
Sheets("Tabelle2").Columns("A:B").Delete
End Sub

Salut

AW: Find-Function

22.11.2006 08:25:54

Hugo

Hallo xlSchnack
Leider funktioniert Deine Lösung nicht ganz wie gewünscht. Es werden sämtliche Daten ab Spalte C (D,E,F,G usw.) auch kopiert.
Gruss Hugo

AW: Find-Function

22.11.2006 11:26:30

xlSchnack

Hi Hugo,
ich kriege den Code derzeit nicht so angepasst, dass er nur die Treffer aus Spalte C in Spalte A des anderen Blattes einfügt.
Ist aber bestimmt machbar, nur der Groschen ist noch nicht gefallen, wie.
Solange könntest du ans Makroende noch folgende Zeile einfügen:
Sheets("Tabelle2").Columns("B:IV").Delete
Salut

Alternative mit Formel-Code

22.11.2006 12:08:44

xlSchnack

Hi Hugo,


Sub Index()
Sheets("Tabelle2").Range("A:A").FormulaR1C1 = "=IF(INDEX(Tabelle1!C,(ROW()+1)*1)<>"""",INDEX(Tabelle1!C[2],(ROW()+1)*1),"""")"
Sheets("Tabelle2").Range("A:A").Value = Sheets("Tabelle2").Range("A:A").Value
Sheets("Tabelle2").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Mein Beispiel geht davon aus, dass du in Zeile1 in Tabelle1 eine Überschriftenzeile hast, ansonsten in der ersten Codezeile an beiden Stellen "+1" löschen.
So werden nur die Treffer aus Spalte C rübergeholt. Wenn du den Bereich deinen Gegebenheiten anpasst, wird es auch nochmal schneller, weil hier ja die ganze Spalte abgeklappert wird.
Salut

Beliebteste Forumthreads (12 Monate)

Forumthread: Übertragen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread