Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
764to768
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
764to768
764to768
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

kopieren wenn

kopieren wenn
23.05.2006 16:41:57
selo
Hallo an alle
habe da mal eine frage
ich habe ein tabellenblatt1 mit einer tabelle.
ich bräuchte ein vba code mit dem die zeile 15 ab spalte E kontrolliert wird ob hierin ein bestimmter text (hier Gruppe1) steht, wenn dies der fall ist sollen die werte welche unter diesem text stehen in tabellenblatt 2 b1 kopiert werden und in die Spalte A soll die reihe mit den dazugehörigen werten kopiert werden.
Das problem ist das die werte in tabellenblatt1 variabel sind also das auch mal werte ab spalte H15,I15 usw stehen können
hat vielleicht jemand einen tip für mich.
lade nochmals eine mappe hoch zur veranschaulichung
https://www.herber.de/bbs/user/33874.xls

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: kopieren wenn
24.05.2006 12:06:32
Franz
Hallo selo,
folgende des Makro kopiert flexible die Daten aus Tabelle 1 nach Tabelle 2

Sub DatenTransfer()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim Datum As Range, Suchen As Range, Finden As String, Zelle As Range
Set wks1 = ActiveWorkbook.Sheets("Tabelle1")
Set wks2 = ActiveWorkbook.Sheets("Tabelle2")
'Suchbegriff für Zeile 15 eingeben
Finden = InputBox("Suchtext?", , "Test")
With wks1
Zeile = 15 ' Zeile mit zu durchsuchenden Texten
LetzteZeile = .UsedRange.Row + .UsedRange.Rows.Count - 1
Set Datum = .Range(.Cells(Zeile, "D"), .Cells(LetzteZeile, "D")) 'Spalte mit Datumswerten
'Zeile 15 ab Spalte "E" durchsuchen und Daten kopieren
For Each Zelle In .Range(.Cells(Zeile, "E"), .Cells(LetzteZeile, .UsedRange.Column + .UsedRange.Columns.Count - 1))
If Zelle.Value = Finden Then
Set Suchen = .Range(.Cells(Zeile, Zelle.Column), .Cells(LetzteZeile, Zelle.Column))
wks2.Cells.Clear
Datum.Copy
wks2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues 'Werte kopieren
wks2.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats 'Formate kopieren
Suchen.Copy wks2.Cells(1, 2)
Application.CutCopyMode = False
wks2.Activate
End If
Next
End With
End Sub

mfg
Franz
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige