Werte suchen und kopieren

Bild

Betrifft: Werte suchen und kopieren von: fritz renner
Geschrieben am: 25.03.2005 15:11:53

Hallo

Ich möchte in einer Tabelle bestimmte Eintragungen suchen und dann die benachbarte Zelle kopieren und in ein anderes Tabellenblatt übertragen. In der beigefügten Tabelle soll z.B. die Buchstaben "B" gesucht werden und dann die darunterliegenden Zellen kopiert werden und diese Werte dann als durchgehende Zeile in ein neues Tabellenblatt eingefügt werden (ab z.B. Zelle C2)

Gruß
Fritz


https://www.herber.de/bbs/user/20157.xls

Bild


Betrifft: AW: Werte suchen und kopieren von: Herbert H.
Geschrieben am: 26.03.2005 09:43:47

Hallo Fritz,
in deiner Tabelle ist irgend etwas vorhanden,
was eine Fehlermeldung beim Kopieren verursacht...
in meiner Mustertabelle ist ein Beispiel für den Monat Jänner...



Option Explicit

Sub xy()
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim ls%, s%

Set sh = Worksheets("2003")
Set sh1 = Worksheets("Tabelle2")


For s = 3 To 21
   If sh.Cells(5, s).Value = "A" Then
      ls = sh1.Cells(3, Columns.Count).End(xlToLeft).Column + 1
      Range(sh.Cells(9, s), sh.Cells(10, s)).Copy sh1.Cells(3, ls)
      Range(sh1.Cells(3, ls), sh1.Cells(4, ls)).Interior.ColorIndex = 35
   End If
Next


For s = 3 To 21
   If sh.Cells(5, s).Value = "B" Then
      ls = sh1.Cells(6, Columns.Count).End(xlToLeft).Column + 1
      Range(sh.Cells(11, s), sh.Cells(12, s)).Copy sh1.Cells(6, ls)
      Range(sh1.Cells(6, ls), sh1.Cells(7, ls)).Interior.ColorIndex = 37
   End If
Next


For s = 3 To 21
   If sh.Cells(5, s).Value = "C" Then
      ls = sh1.Cells(9, Columns.Count).End(xlToLeft).Column + 1
      Range(sh.Cells(13, s), sh.Cells(14, s)).Copy sh1.Cells(9, ls)
      Range(sh1.Cells(9, ls), sh1.Cells(10, ls)).Interior.ColorIndex = 38
   End If
Next

End Sub


     
https://www.herber.de/bbs/user/20176.xls

Gruß Herbert


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Werte suchen und kopieren"