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

Wert abfrage - Zellen kopieren

Wert abfrage - Zellen kopieren
19.09.2003 16:58:38
Wolfgang
Hallo

hätte folgendes Problem:

es soll in einer Spalte nach dem wert 1 gesucht werden - ist er vorhanden - sollen verschiedene Zellen in einer Zeile auf einem neuen Blatt kopiert werden.

-in jeder Spalte sind 59 Zeilen, vobei erst ab zeile 3 gesucht werden soll
-es sind 200 Spalten...

ein Beispiel:
A B
1 TE 130 ...
2 ZE 001
3 100 1
4 101 1
5 102 0
6 103 1
7 104 0
8 105 1
9 106 1
.
.
wenn nun in Spalte B3 eine 1 ist, dann soll B1 + B2 + A3 in eine Zeile einer Neuen Tabelle kopiert werden, und so weiter bis B59

ich hoffe jemand kann mir helfen...

vorab vielen Dank

Wolfgang

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Benutzer
Eigentlich kein Problem...
19.09.2003 18:39:30
Ramses
Hallo,

... wenn du das etwas besser erklärst:

Willst du nur in einer Spalte suchen
oder soll der Suchbegriff in allen Spalten gesucht werden

Wenn der Wert in B43 gefunden wird soll, welche Zellen sollen dann kopiert werden ?

Wenn du in allen Spalten suchen willst, welche Zellen sollen dann kopiert werden ?

Gruss Rainer
AW: Eigentlich kein Problem...
19.09.2003 18:54:00
Wolfgang
hallo Ramses

melde mich erst jetzt weil ich leider keine Mitteilung erhalten habe ...

also zu

Es soll in einer Spalte und zwar beginnend bei B3 bis B59 und jedesmal wenn der Wert 1 gefunden wird sollen folgende Zellen B1 und B2 sowie Ax in ein vorhandenes Tabellenblatt in die nächste freie Zeile kopiert werden

wenn in B43 der Wert gefunden wird sollen die Zellen B1,B2 und A43 kopiert werden

wenn bei B59 angekommen nächste Spalte also C3 bis C59
wenn nun in C43 der Wert gefunden wird sollen die Zellen C1,C2 und A43 kopiert werde

ich hoffe es ist verständlich...

vielen Dank für Deine Hilfe vorab...

Wolfgang
Dann sollte es so gehen...
19.09.2003 19:25:38
Ramses
Hallo


Option Explicit

Sub Find_Value()
Dim Cr As Long, Cc As Integer, myRange As Range, myC As Range
Dim fStr As Variant, wks As String
Set myRange = Range("B3:D22") 'Bitte anpassen
wks = "Tabelle2" 'Dort wo die Werte hinkopiert werden sollen
fStr = InputBox("Bitte Suchbegriff eingeben:", "Suche starten", "a")
If IsEmpty(fStr) Or fStr = "" Then
    MsgBox ("Kein Suchbegriff erkannt. Makro wird abgebrochen")
    Exit Sub
End If
'Bildschirmaktualisierung ausschalten
'Application.ScreenUpdating = False
For Each myC In myRange
    If myC.Value = fStr Then
        Worksheets(wks).Cells(Worksheets(wks).Cells(65536, 1).End(xlUp).Row + 1, 1) = myC.Address
        Worksheets(wks).Cells(Worksheets(wks).Cells(65536, 1).End(xlUp).Row, 2) = _
            Cells(1, myC.Column).Value
        Worksheets(wks).Cells(Worksheets(wks).Cells(65536, 1).End(xlUp).Row, 3) = _
            Cells(2, myC.Column).Value
        Worksheets(wks).Cells(Worksheets(wks).Cells(65536, 1).End(xlUp).Row, 4) = _
            Cells(myC.Row, 1).Value
    End If
Next
Worksheets(wks).Activate
Worksheets(wks).UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Columns("A:A").Delete
'Application.Screenupdating = True
End Sub 
     Code eingefügt mit Syntaxhighlighter 1.16



Gruss Rainer
AW: Dann sollte es so gehen...
19.09.2003 19:50:04
Wolfgang
Danke für die schnelle Antwort

Set myRange = Range("B3:D22") 'Bitte anpassen
gebe ich hier den Bereich der 1.Spalte an also B3:B59 oder den Bereich B3 bis IO59

wenn ich B3:B59 nehme und starte läuft das Makro bis hier

Worksheets(wks).UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

dabei kommt 1004

es wird aber auch nichts in die neue Tabelle eingetragen...

bitte helfe mir weiter ...

Anmerkung würde es Dir helfen wenn ich Dir die Mappe schicke ??
AW: Dann sollte es so gehen...
19.09.2003 19:58:33
Ramses
Hallo

"Set myRange = Range("B3:D22") 'Bitte anpassen
gebe ich hier den Bereich der 1.Spalte an also B3:B59 oder den Bereich B3 bis IO59"

Ich denke ich habe das klar geschrieben, ... oder habe ich nur eine Spalte angegeben :-)
natürlich den ganzen Bereich der durchsucht werden soll

"...dabei kommt 1004..."

Hast du den Namen der Tabelle angepasst, wohin das kopiert werden soll ?

wks = "Tabelle2" 'Dort wo die Werte hinkopiert werden sollen


"...es wird aber auch nichts in die neue Tabelle eingetragen..."

Das Makro habe ich getestet und es funktioniert


"...Anmerkung würde es Dir helfen wenn ich Dir die Mappe schicke ??...."

Mache ich prinzipiell nicht. Wer weiss was ich da alles kriege :-)

Hier eine Beispieldatei

https://www.herber.de/bbs/user/1092.xls


Gruss Rainer
AW: Dann sollte es so gehen...
19.09.2003 20:38:17
Wolfgang
erstmal DANKE

wollte Dir nicht zu nahe treten finde es ja toll das Du mir hilfst...
habe nur zur Sicherheit nachgefragt...
---------------------------------------------------------------------

also auch wenn ich das angegebene Beispiel herunterlade und ausführe
bekomme ich folgende Meldung: "Fehler beim kompilieren - Variable nicht deklariert"

und im VBA-Editor ist in folgender Anweisung folgendes: xlSortNormal markiert

Worksheets(wks).UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

was ist den los...
AW: Dann sollte es so gehen...
19.09.2003 20:48:16
Ramses
Hallo

das mag XP-Spezifisch sein :-)
Kommentiere es einfach aus oder lösche es, dass die letzten Zeilen so aussehen

Worksheets(wks).UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("A:A").Delete

Gruss Rainer
ES Funktioniert...
19.09.2003 22:17:10
Wolfgang
ja, ja habs jetzt bei meinem Orginal ausprobiert -ES KLAPPT-

es wurden 6477 zeilen erstellt - gut das Du mir geholfen hast -

DANKE
Merci für's Feedback :-) o.T
19.09.2003 22:23:43
Ramses
...

Meistgelesene Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Ihre Stimme zählt!