Suchen und kopieren

Forumthread: Suchen und kopieren

Suchen und kopieren

20.01.2020 18:07:15

Mike

Hallo an alle Excel Spezialisten,
Ich brauche eure Hilfe. Ich bin absoluter Neuling in VBA (ist trotzdem super). Nun zu meinem Probleme. Ich habe im Blatt "1" von A4:KM4 Daten. Nun soll Excel in Blatt "2" den Zellenwert von Blatt "1" A4 in Blatt "2" von A1:A500 suchen, wenn gefunden, in diese stelle den Wert von Blatt "1" von A4:KM4 kopieren.
Jedenfalls Großen DANK für eure Hilfe

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Suchen und kopieren

20.01.2020 19:45:09

Piet
AW: Suchen und kopieren

20.01.2020 23:26:38

Mike
AW: Suchen und kopieren

21.01.2020 09:08:44

Mike
AW: Suchen und kopieren

21.01.2020 11:24:31

guennih
AW: Suchen und kopieren

21.01.2020 15:40:37

Mike
AW: Suchen und kopieren

20.01.2020 19:58:36

Guennih

AW: Suchen und kopieren

20.01.2020 19:45:09

Piet

Hallo
zwei Makros, die beide funktionieren, zum VBA lernen! Das erste mit der Find Mehtode, das zweite eine Standard For Next Schleife. Sollen mehr Werte als nur A4 kopiert werden muss das For Next Makro erweitert werden.
mfg Piet

Option Explicit
Dim rFind As Range, SuchTxt As String
Sub Daten_suchen_kopieren_Find()
Dim TB2 As Worksheet  'Tabelle2
Set TB2 = Worksheets("Blatt2")
'With Klammer vereinfacht Schreibweise
With Worksheets("Blatt1")
SuchTxt = .Range("A4").Value   'Suchlauf nach Suchtext
Set rFind = TB2.Columns(1).Find(What:=SuchTxt, After:=Cells(1, 1), LookIn:= _
xlFormulas, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
'Fehlermeldung wenn Suchtext nicht gefunden wird
If rFind Is Nothing Then MsgBox SuchTxt & " nicht gefunden!": Exit Sub
'Suchtext kopieren und einfügen
If Not rFind Is Nothing Then
.Range("A4:KM4").Copy rFind
End If
End With
End Sub
Sub Daten_suchen_kopieren_ForNx()
Dim AC As Range, lz1 As Long
Dim TB2 As Worksheet  'Tabelle2
Set TB2 = Worksheets("Blatt2")
'Dasselbe über For Next Schleife
With Worksheets("Blatt1")
SuchTxt = .Range("A4").Value
lz1 = TB2.Cells(Rows.Count, 1).End(xlUp).Row
For Each AC In TB2.Range("A1:A" & lz1)
If AC.Value = SuchTxt Then
.Range("A4:KM4").Copy AC
Exit For
End If
Next AC
End With
End Sub

AW: Suchen und kopieren

20.01.2020 23:26:38

Mike

Vielen Dank für die Formeln und Erklärungen, doch leider kopiert er Formeln mit. Ich brauche aber nur den Inhalt ohne Formeln.

AW: Suchen und kopieren

21.01.2020 09:08:44

Mike

AW: Suchen und kopieren

21.01.2020 11:24:31

guennih

Hallo,

.Range("A4:KM4").Copy rFind

ersetzen durch

.Range("A4:KM4").Copy
rFind.pastespecial xlPasteValues

und du erhältst am Ziel die Werte

AW: Suchen und kopieren

21.01.2020 15:40:37

Mike

Yes :-) Wirklich GROSSEN DANK an alle !!

AW: Suchen und kopieren

20.01.2020 19:58:36

Guennih

Aktiviere im Ribbon die Menügruppe "Entwicklertools"
Drücke "Makro aufzeichnen"
Führe obige Aktion durch
Drücke Aufzeichnung beenden
gehe zum VBA-Code und schau Dir das Ergebnis an
Ersetzte jetzt bei der Find-Funktion das Argument mit dem Inhalt von A4 durch


Sheets("Tabelle1").Range("A4")

Wenn Du Glück hast, ist das alles! hängt ein bisschen davon ab was Du sonst noch so alles klickst
Den erhaltenen Code kannst Du ja nochmal hier zur Korrektur Ergänzung einstellen

Beliebteste Forumthreads (12 Monate)

Forumthread: Suchen und kopieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread