finden und kopieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox


Excel-Version: 5.0/7.0
nach unten

Betrifft: finden und kopieren
von: Pam
Geschrieben am: 29.05.2002 - 19:35:47

Hallo Excel-Freunde,
habe im Tabellenblatt 1 in A1 einen Namen. Über eine Schaltfläche soll dieser Name im Tabellenblatt 2 in der Spalte A gesucht werden. Wird er gefunden, sollen die Daten in den angrenzenden Spalten B,C und D und hier allerdings 16 Zeilen kopiert und im Tabellenblatt 1 neben dem gesuchten Namen eingetragen werden.
Wer kann mir helfen?

nach oben   nach unten

Re: finden und kopieren
von: WernerB.
Geschrieben am: 29.05.2002 - 20:58:20

Hallo Pam,

teste mal diesen Code (in Version '97 erstellt):


Option Explicit
Sub SucheUndFinde()
Dim SuBe As Range
Dim As String, lo As String, ru As String
Dim As Long, laR As Long
    s = Sheets("Tabelle1").Range("A1").Value
    laR = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row
    Set SuBe = Sheets("Tabelle2").Range("A1:A" & laR).Find(s, lookat:=xlPart)
    If Not SuBe Is Nothing Then
      lo = Cells(SuBe.Row, 2).Address(False, False)
      ru = Cells(SuBe.Row + 15, 4).Address(False, False)
      Sheets("Tabelle2").Range(lo & ":" & ru).Copy
      Sheets("Tabelle1").Range("B1:D16").PasteSpecial Paste:=xlAll, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Application.CutCopyMode = False
    Else
      MsgBox "Der Suchbegriff '" & s & "' wurde nicht gefunden !", _
        vbExclamation, "Hinweis für " & Application.UserName & ":"
    End If
End Sub

Viel Erfolg wünscht
WernerB.
nach oben   nach unten

Re: finden und kopieren
von: Pam
Geschrieben am: 30.05.2002 - 09:36:34

Danke WernerB. das Makro funktioniert.
Vielleicht kannst Du mir noch mal helfen.
Nach der Änderung in den kopierten Daten im Tabellenblatt 1 sollen diese an die gleiche Stelle im Tabellenblatt 2 aktuallisiert zurückkopiert werden.

nach oben   nach unten

Re: finden und kopieren
von: WernerB.
Geschrieben am: 30.05.2002 - 09:54:05

Hallo Pam,

hier das Makro zum Zurückschreiben (ungetestet):


Option Explicit
Sub ZurueckSchreiben()
Dim SuBe As Range
Dim As String, lo As String, ru As String
Dim As Long, laR As Long
    s = Sheets("Tabelle1").Range("A1").Value
    laR = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row
    Set SuBe = Sheets("Tabelle2").Range("A1:A" & laR).Find(s, lookat:=xlPart)
    If Not SuBe Is Nothing Then
      lo = Cells(SuBe.Row, 2).Address(False, False)
      ru = Cells(SuBe.Row + 15, 4).Address(False, False)
      Sheets("Tabelle1").Range("B1:D16").Copy
      Sheets("Tabelle2").Range(lo & ":" & ru).PasteSpecial Paste:=xlAll, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Application.CutCopyMode = False
    Else
      MsgBox "Der Suchbegriff '" & s & "' wurde nicht gefunden !", _
        vbExclamation, "Hinweis für " & Application.UserName & ":"
    End If
End Sub

Viel Erfolg wünscht
WernerB.
nach oben   nach unten

Re: finden und kopieren
von: Pam
Geschrieben am: 30.05.2002 - 12:59:57

Wunderbar, bis demnächst

 nach oben

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