Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Bereich kopieren + via Suchkriterium einfügen

VBA: Bereich kopieren + via Suchkriterium einfügen
07.11.2017 08:36:38
Nadine
Hallo liebes Forum,
ich bin leider bislang im Alleingang gescheitert, dabei ist meine Aufgabe glaube ich gar nicht so schwer:
Tabelle1 wird als Formular genutzt. Dort befindet sich in Zelle AJ97 das Suchkriterium, es sind Zahlen im Format "0000". Der zu kopierende Bereich ist AL99:DL99 (= Essenz des Formulars, alles nebeneinander).
In Tabelle2 befindet sich die Übersichtsliste, dort in Spalte B die Eintragsnummern im Format "0000" (= Suchkriterium).
In Tabelle1 befindet sich ein Makro-Button, der bei Betätigung folgende Aktion ausführen soll: Suche Suchkriterium Tabelle1.Range("AJ97"), z.B. Eintrag "0007" in Tabelle2.Range("B:B"), wenn gefunden, dann kopiere Tabelle1.Range("AL99:DL99"), gehe in die entsprechende Zeile in Tabelle2, und füge ein als Werte beginnend bei Spalte D (also 2 Zellen nach rechts springen, dann Strg+P). Danach in der Zeile, in der gerade eingefügt wurde, die jeweilige Zelle in Spalte C markieren.
Falls Suchkriterium in Tabelle2.Range("B:B") nicht gefunden, dann zeige in Tabelle1 MsgBox "Entry Number " & Format(GesuchterWert, "0000") & " not existing!"
Ich danke euch schon vorab für euren Input.
Ganz liebe Grüße

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Bereich kopieren + via Suchkriterium einf
07.11.2017 09:29:23
Michael
Hallo!
So?
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim rKrit As Range: Set rKrit = WsQ.Range("AJ97")
Dim rC As Range: Set rC = WsQ.Range("AL99:DL99")
Dim rS As Range, f As Range
Application.ScreenUpdating = False
With WsZ
.Activate
Set rS = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
Set f = rS.Find(what:=rKrit, LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
rC.Copy f.Offset(, 2)
f.Offset(, 1).Select
Else:
WsQ.Activate
MsgBox "Entry Number " & rKrit & " not existing!"
End If
End With
Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing: Set rKrit = Nothing
Set rC = Nothing: Set rS = Nothing: Set f = Nothing
End Sub
LG
Michael
Anzeige
AW: VBA: Bereich kopieren + via Suchkriterium einf
07.11.2017 15:36:09
Nadine
Hallo Michael,
vielen Dank schon vorab. Bei einem Test funktioniert es noch nicht ganz. Und zwar wird z.B. der Wert "7" = "0007" = aktueller Wert in Suchkriteriums-Zelle Tabelle1.AJ97 nicht in Tabelle 2 gefunden, obwohl dieser dort existent ist. allerdings wird "0007" über eine Formel in Tabelle2 berechnet. Wenn ich bei .Find xlValues gegen xlFormalas austausche, wird der Eintrag leider trotzdem nicht gefunden. Hast du eine Idee? Danke schon vorab
LG, Nadine
AW: VBA: Bereich kopieren + via Suchkriterium einf
07.11.2017 16:05:11
Michael
Hallo!
Versuch's mal so:
'...
Set f = rS.Find(what:=Format(rKrit, "0000"), LookIn:=xlValues, lookat:=xlWhole)
'...
Wenn nicht wär eine Beschreibung Deiner Daten hilfreich ("0007" ist ein Text bzw. ggf. ein Zahlen-Format, 7 eine Zahl!).
LG
Michael
Anzeige
AW: VBA: Bereich kopieren + via Suchkriterium einf
07.11.2017 16:22:49
Nadine
Hallo Michael,
super, jetzt wird das Suchkriterium gefunden. Vielen Dank.
Allerdings wird gerade der kopierte Bereich Tabelle1."DL99:Al99" als Formel in Tabelle2 eingefügt, ich bräuchte es als Werte. Bitte um kurze Hilfestellung und vielen, vielen Dank schon bis hierher.
AW: VBA: Bereich kopieren + via Suchkriterium einf
07.11.2017 16:39:30
Michael
So
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim rKrit As Range: Set rKrit = WsQ.Range("AJ97")
Dim rC As Range: Set rC = WsQ.Range("AL99:DL99")
Dim rS As Range, f As Range
Application.ScreenUpdating = False
With WsZ
.Activate
Set rS = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
Set f = rS.Find(what:=Format(rKrit, "0000"), LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
rC.Copy
f.Offset(, 2).PasteSpecial xlPasteValuesAndNumberFormats
f.Offset(, 1).Select
Else:
WsQ.Activate
MsgBox "Entry Number " & rKrit & " not existing!"
End If
End With
Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing: Set rKrit = Nothing
Set rC = Nothing: Set rS = Nothing: Set f = Nothing
End Sub
Wenn Deine vollständigen Anforderungen von Anfang an klar gewesen wären, müssten wir nicht in die 3. Code-Schreibe-Runde gehen ;-).
LG
Michael
Anzeige
AW: VBA: Bereich kopieren + via Suchkriterium einf
07.11.2017 16:55:09
Nadine
Super, danke dir. Jetzt funktioniert es einwandfrei.
Habe versucht, alle Bedingungen zu beschreiben, aber es waren halt nicht 100%. Nächstes Mal gelobe ich Besserung.
Dir noch mal 1000 Dank, you saved my day, my week, my mood ...
LG, Nadine
Na fein, freut mich! Danke für die Rückmeldung owT
07.11.2017 17:01:35
Michael

339 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige