Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1832to1836
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
Inhaltsverzeichnis

Anpassen

Anpassen
06.06.2021 17:02:46
Eberhard
Guten Tag
Ich habe einen Code gefunden und etwas angepasst. Er sucht mir in Spalte (6) nach einem Wert.
Danach sollte er mir die gefundenen Zeilen, von Spalte "A" bis Spalte "E" in ein anderes Tabellenblatt kopieren. Doch Leider kopiert es mit gerade die Spalten welche ich eigentlich nicht brauche. Wie muss ich den Code anpassen?
Vielen Dank für Eure Hilfe.
Gruss Daniel

Dim rng As Range
Dim vWert As Variant
Dim sFirstAdress As String
vWert = InputBox(prompt:="Bitte Nummer eingeben:", Title:="Suche")
With Worksheets("WSCAR_Daten")
Set rng = .Columns(6).Find(vWert)
If rng Is Nothing Then
MsgBox "Wert " & vWert & " nicht gefunden!"
Else
sFirstAdress = rng.Address
Do
Call rng.Resize(1, 1).Copy(Destination:= _
Worksheets("Lagerliste_Drucken").Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0))
Set rng = .Columns(6).FindNext(rng)
Loop Until rng.Address = sFirstAdress
End If
End With

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Anpassen
06.06.2021 17:10:35
Hajo_Zi
Call Range(Cells(ng.Row,1), Cells(rng.row,5)).Copy(Destination:= _
GrußformelHomepage
AW: Anpassen
06.06.2021 18:22:20
Eberhard
Hallo zusammen
Habe den Code versucht anzupassen. Funktioniert aber leider nicht! Was ist falsch?

Dim rng As Range
Dim vWert As Variant
Dim sFirstAdress As String
vWert = InputBox(prompt:="Bitte Nummer eingeben:", Title:="Suche")
With Worksheets("WSCAR_Daten")
Set rng = .Columns(6).Find(vWert, _
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If rng Is Nothing Then
MsgBox "Wert " & vWert & " nicht gefunden!"
Else
sFirstAdress = rng.Address
Do
Call Range(Cells(rng.Row, 1), Cells(rng.Row, 5)).Copy(Destination:= _
Worksheets("Lagerliste_Drucken").Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0))
Set rng = .Columns(6).FindNext(rng)
Loop Until rng.Address = sFirstAdress
End If
End With

Anzeige
AW: Anpassen
06.06.2021 18:23:39
Hajo_Zi
Zu Deiner Datei kann ich nichts schreiben, was wohl daran liegt das ich nicht auf fremde Rechner schaue.Ich baue keine Datei nach.
Sollte die Datei verlinkt werden?
Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten
http://www.ms-office-forum.de/forum/showthread.php?t=322895
ändern.
Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.
http://www.excel-ist-sexy.de/bilder-statt-datei/
Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.
Das ist nur meine Meinung zu dem Thema.
http://www.excel-ist-sexy.de/bilder-statt-datei/
Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.
Das ist nur meine Meinung zu dem Thema.
Gruß Hajo
Anzeige
AW: Anpassen
06.06.2021 18:54:40
Werner
Hallo Hajo,
wozu du nicht alles eine Mappe brauchst ?!?
Hättest du dir den unrsprünglichen Code mal angeschaut, dann hättest du gesehen, dass dort ein With - End With verwendet wird.
Dann hättest du auch gleich was liefern können mit einem Punkt vor den Range-Objekten.
Würde mal vermuten, dass es dadurch an der fehlerhaften Referenzierung liegt.
Gruß Werner
man kann auf angebotene Hilfe reagieren...
06.06.2021 18:56:05
Werner
Hallo Eberhard,
...müssen muss man natürlich nicht.
Bleibt mir nur der Dank fürs Ignorieren.
Gruß Werner
AW: man kann auf angebotene Hilfe reagieren...
06.06.2021 19:15:07
Eberhard
Hallo Werner
Sorry, ist doch nicht böse gemeint. Habe den Code versucht anzupassen um was zu lernen.
Zudem hat sich das ganze überschnitten! Kaum hatte ich den Beitrag abgeschickt, habe ich Dein Vorschlag erhalten. Was auch funktioniert.
Ich habe Dein Code noch versucht anzupassen, da ich keine Überschriften verwende.
Habe bei den beiden "Offset(1)" ein "Offset(0)" gemacht. Nun funktioniert es wunderbar.
Hoffe Du kannst mir verzeihen.?
Besten Dank Werner. Werde natürlich dein Code verwenden und wenn ich nicht weiter komme, würde ich gerne wieder Fragen dürfen?
Gruss Daniel
Anzeige
AW: man kann auf angebotene Hilfe reagieren...
07.06.2021 07:27:17
Werner
Hallo,
Nun funktioniert es wunderbar.
Das bezweifle ich, wenn du nur die beiden Offset-Werte von 1 auf 0 geändert hast und sonst nichts.
1. durch Änderung des ersten Offset von 1 auf 0, ohne Anpassung des Resize, kopierst du dir das Filterergebnis ohne die letzte Zeile
2. durch Änderung des zweiten Offset von 1 auf 0 überschreibst du dir im Zielblatt immer die letzte Zeile
Gruß Werner
AW: man kann auf angebotene Hilfe reagieren...
07.06.2021 09:27:26
Eberhard
Hallo Werner
Stimmt, Du hast recht! Wenn ich in der Tabelle "WSCAR_Daten" zum Beispiel die Spalte(6) nach dem Buchstabe "A" zähle, komme ich auf 9 Zeilen. Mir kopiert es allerdings nur 7 Zeilen! Also Überschriften in den Tabellenblätter habe ich keine! Was muss ich da noch alles ändern?
Gruss Daniel
Anzeige
AW: man kann auf angebotene Hilfe reagieren...
07.06.2021 09:47:04
Werner
Hallo,
am einfachsten wäre es, einfach vor deinen Daten eine Zeile mit Überschriften einzufügen und den Code so zu lassen, wie ich ihn gepostet habe.
Gruß Werner
AW: man kann auf angebotene Hilfe reagieren...
07.06.2021 11:26:07
Eberhard
Hallo Werner
Ok, mache ich sobald ich Zeit finde. Sollte ich nicht zurecht kommen, würde ich mich gerne wieder melden.
Gruss Daniel
ohne Überschriftenzeile.
07.06.2021 12:39:15
Daniel
Hi
wenn du keine Überschriftenzelle hast, funktioniert auch folgender Code, allerdings müssen in Spalte F fixe Werte stehen, keine Formeln.

Sub test()
Dim rng As Range
Dim vWert As Variant
Dim sFirstAdress As String
vWert = InputBox(prompt:="Bitte Nummer eingeben:", Title:="Suche")
With Worksheets("WSCAR_Daten").Columns(6)
If WorksheetFunction.CountIf(.Cells, vWert) Then
.Replace vWert, True, xlWhole
With .SpecialCells(xlCellTypeConstants, 4)
Intersect(.Worksheet.Range("A:E"), .EntireRow).Copy _
Destination:=Worksheets("Lagerliste_Drucken").Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
.Value = vWert
End With
End If
End With
End Sub
das prinzip ist hier, dass man den gesuchten Wert durch einen Wahrheitswert austauscht.
auf Werte eines bestimmten Typs (Zahl, Text, Wahrheitswert, Fehler), kann man in Excel gezielt zugreifen und auswählen.
Damit lassen sich dann alle Werte in einem Schritt kopiren.
Eine Überschriftenzeile wie beim Autofilter wird nicht benötgt.
Gruß Daniel
Anzeige
AW: Anpassen
06.06.2021 17:40:49
Werner
Hallo,
warum denn mit Find und Find next?
Warum nicht per VBA mit dem Autofilter?
Gruß Werner
AW: Anpassen
06.06.2021 18:20:48
Werner
Hallo,
würde ich so machen:

Public Sub Filter()
Dim strWert As String
Application.ScreenUpdating = False
With Worksheets("WSCAR_Daten")
strWert = InputBox(prompt:="Bitte Nummer eingeben:", Title:="Suche")
If Not strWert = vbNullString Then
If WorksheetFunction.CountIf(.Columns(6), strWert) > 0 Then
.Range("A1").AutoFilter field:=6, Criteria1:=strWert
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Columns("A:E").Copy _
Worksheets("Lagerliste_Drucken").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
Else
MsgBox "Der Suchgegriff " & strWert & " wurde nicht gefunden."
Exit Sub
End If
End If
.Range("A1").AutoFilter
End With
End Sub
Ausgehend davon, dass die Daten in Zeile 2 beginnen und in Zeile 1 Überschriften vorhanden sind.
Gruß Werner
Anzeige
AW: Anpassen
06.06.2021 19:12:26
Daniel
Hi
Am einfachsten so beim kopieren:

Call rng.offset(0, -5).resize(1, 5).Copy Destination:=....
Gruß Daniel

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige