Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
728to732
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
728to732
728to732
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Suchen und Kopieren
07.02.2006 15:40:48
Paul
Hallo,
ich moechte per Macro in einem Sheet den Eintrag "Grand Total" finden und dann die 20 Werte unter dem Eintrag kopieren und in in dem Sheet mit dem Namen "Input", ebenfalls unter dem Eintrag "Grand Total", einfuegen. Unter https://www.herber.de/bbs/user/30757.xls ist eine Beispieldatei hintelegt. Vielleicht kann mir da jemand helfen.
Paul

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

Betreff
Datum
Anwender
Anzeige
AW: Suchen und Kopieren
07.02.2006 16:27:29
Peter
Servus,
so generell würde ich dir erstmal raten dir Gedanken zu deinem Tabellenaufbau zu machen und dann so eine Frage zu stellen. Aber what ever, z.B. so.
Sub t()
Dim lzeile(1) As Long, lngSuch(1) As Long
Dim myarr
On Error GoTo Fehler
With Sheets("Sheet1")
lzeile(0) = .Cells(.Rows.Count, 4).End(xlUp).Row
lngSuch(0) = Application.WorksheetFunction.Match("Grand Total", _
.Range("D1:D" & lzeile(0)), 0)
End With
With Sheets("Input")
lzeile(1) = .Cells(.Rows.Count, 1).End(xlUp).Row
lngSuch(1) = Application.WorksheetFunction.Match("Grand Total", _
.Range("A1:A" & lzeile(1)), 0)
myarr = Sheets("Sheet1").Range("D" & lngSuch(0) + 1 & ":D" & lngSuch(0) + 21)
.Range("A" & lngSuch(1) + 1 & ":A" & lngSuch(1) + 21) = myarr
End With
Fehler:
If Err.Number = 1004 Then
MsgBox "Nicht gefunden !", vbCritical
ElseIf Err.Number <> 0 Then MsgBox "Fehler-Nr.: " & Err.Number & " Beschreibung: " & Err.Description, vbCritical, "FEHLER !"
End If
End Sub

MfG Peter
Anzeige
AW: Suchen und Kopieren
07.02.2006 16:39:52
Paul
Danke!
AW: Suchen und Kopieren
07.02.2006 16:59:34
Peter
Hallo Paul,
so geht es:

Sub SuchenKopieren()
Dim Rng       As Range
Dim StrtAdrQ  As String
Dim StrtAdrZ  As String
   Sheets("Tabelle1").Activate
   With Sheets("Tabelle1")
      Set Rng = Columns("D:D").Find( _
         what:="Grand Total", _
         lookat:=xlWhole, _
         LookIn:=xlValue)
      If Not Rng Is Nothing Then
         StrtAdrQ = Rng.Row
      End If
   End With
   Sheets("Input").Activate
   With Sheets("Input")
      Set Rng = Columns("A:A").Find( _
         what:="Grand Total", _
         lookat:=xlWhole, _
         LookIn:=xlValue)
      If Not Rng Is Nothing Then
         StrtAdrZ = Rng.Row
      End If
   End With
   
   If StrtAdrQ <> "" And StrtAdrZ <> "" Then
      Worksheets("Tabelle1").Range("D" & StrtAdrQ + 1 & ":D" & StrtAdrQ + 21).Copy _
         Destination:=Worksheets("Input").Range("A" & StrtAdrZ + 1)
   End If
Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
Anzeige
AW: Suchen und Kopieren
07.02.2006 17:21:03
Paul
Hallo,
danke fuer die Hilfe! Habe es bereits geloest, auch mit Hilfe des Forums.
Gruesse Paul

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige