Office: Spalte nach Eintrag durchsuchen

Hallo,

ich habe folgendes Problem:

ich möchte mit Hilfe eines Makros die Spalte B eines Tabellenblattes durchsuchen lassen, bis die Zeile gefunden wird, in der eine Zahl steht. Die Zahl steht an irgendeiner Stelle in der Spalte B. Aktuell ist es die Zeile 5012. Die Zeilen darüber sind leer.

Erklärung :
In Tabellenblatt 1 möchte ich in B34 bis H34 Zahlen eingeben. In Tabellenblatt 2 ist schon eine Liste mit Zahlenreihen ab B5012:H5012 gespeichert. Wenn ich das Makro auslöse, sollen die Zahlen die ich gerade in Tabellenblatt 1 eingegeben habe, in Tabellenblatt 2 kopiert werden und zwar immer über der letzten Zeile, in der sich Zahlen befinden, sodaß sich die Liste nach oben hin nach und nach aufgefüllt wird

Wenn ich das Makro auslöse müßten also jetzt im Tabellenblatt 2 in der Zeile B5011:H5011 meine zuvor in Tabellenblatt 1 eingegebenen Zahlen stehen.


Ist so etwas möglich und wenn ja, wie? Ich habe keine Ahnung vom programmieren, vielleicht kann mir jemand ein fertges Makro schrieben?

Vielen Dank im voraus

Gruß Novato

 

Hallo!

Teste mal sowas:

Code:

Sub test()
Dim Zeile As Integer
With Sheets("Blatt2")
'Sucht von B1 aus abwärts nach der letzten freien Zelle:
Zeile = .Range("B1").End(xlDown).Row - 1
'Kopiert die Werte:
Range(.Cells(Zeile, 2), .Cells(Zeile, 8)) = Sheets("Blatt1").Range("B34:H34")
End With
End Sub

 

Hallo Schatzi,

vielen Dank fur Deine Antwort. Ich habe Deinen Code ausprobiert, hat aber leider nicht funktioniert.

Ich bin folgendermaßen vorgegangen:

1.Makro erstellt mit dem Namen test
2.Deinen Code reinkopiert ohne etwas zu verändern
3.Tabelle 1 in Blatt 1 umbenant, Tabelle2 in Blatt 2 umbenannt.
3.Makro im Menu Extras aufgerufen und auf ausführen geklickt

Danach habe ich in Blatt 2 nachgeschaut ob die Daten aus Blatt 1 rüberkopiert wurden, konnte sie aber nicht finden.

Eine Fehlermeldung kam auch nicht.

Was habe ich falsch gemacht?

Gruß Novato

 

Hallo!

Da hab' ich wohl zu schnell geschossen...
Aber so sollte es nun wirklich klappen:

Code:

Sub test()
Dim Zeile As Integer
With Sheets("Blatt2")
'Sucht von B1 aus abwärts nach der letzten freien Zelle:
Zeile = .Range("B1").End(xlDown).Row - 1
'Kopiert die Werte:
Sheets("Blatt1").Range("B34:H34").Copy .Cells(Zeile, 2)
End With
End Sub

 

Hi Schatzi,

herzlichen Dank für Deine schnelle Hilfe!!.

Das ist Super Klasse :lol: .
Funktioniert einwandfrei.

Allerdings wird auch die Formatierung (Rahmen) mit kopiert. Wie kann man das noch ändern?

Gruß Novato

 

Hallo!

Dann so:

Code:

Sub test()
Dim Zeile As Integer
With Sheets("Blatt2")
'Sucht von B1 aus abwärts nach der letzten freien Zelle:
Zeile = .Range("B1").End(xlDown).Row - 1
'Kopiert die Werte:
Sheets("Blatt1").Range("B34:H34").Copy
.Cells(Zeile, 2).PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
End Sub

 

Hi Schatzi,

Genau so!!

Wunderbar und vielen Dank nochmals.

Gruß Novato

 

Hi Schatzi,

Tschuldigung, wenn ich nochmal frage:

ist es möglich mit dem gleichen Makro die Werte der ersten gefundenen Zeile aus Blatt 2 zu kopieren und in Blatt 1 in B33:H33 einzutragen, sowie die Werte aus Blatt 2 der darunterliegenden Zeile in Blatt 1 in B32:H32 zu kopieren?

Dies sollte, dann aber geschehen, bevor die Zahlen aus B34:H34 kopiert wurden. weil sonst würde ich sie ja gleich wieder zurück kopieren.

Ich wollte es nicht von anfang an zu kompliziert machen, deshalb die Fragen nacheinander. ;-)

Gruß Novato

 

Hallo!

Ungetestet:

Code:

Sub test()
Dim Zeile As Integer
With Sheets("Blatt2")
Zeile = .Range("B1").End(xlDown).Row - 1

Range(.Cells(Zeile + 1, 2), .Cells(Zeile + 1, 8)).Copy Sheets("Blatt1").Range("B33:H33")
Range(.Cells(Zeile + 2, 2), .Cells(Zeile + 2, 8)).Copy Sheets("Blatt1").Range("B32:H32")

Sheets("Blatt1").Range("B34:H34").Copy
.Cells(Zeile, 2).PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
End Sub

 

Hallo Schatzi,

Vielen Dank!! Einfach genial. Klappt auf anhieb.

Eine Kleinigkeit allerdings: Wenn die Werte aus Blatt 2 in Blatt 1 kopiert werden, geht mir mein Rahmen in Blatt 1 verloren.

Gruß Novato

 

Hallo!

Dann kopiere die oberen beiden genauso wie den unteren:

Code:

Range(.Cells(Zeile + 1, 2), .Cells(Zeile + 1, 8)).Copy
Sheets("Blatt1").Range("B33:H33").PasteSpecial Paste:=xlValues
Range(.Cells(Zeile + 2, 2), .Cells(Zeile + 2, 8)).Copy
Sheets("Blatt1").Range("B32:H32").PasteSpecial Paste:=xlValues

 

Hallo Schatzi,

jetzt sieht es gut aus.

:-D
Vielen Dank noch mal.

Gruß Novato

 

Hallo Schatzi,

ich habe noch eine Frage

folgenden Befehl habe ich vor Deine Zeilen noch hinzugefügt.

Range(.Cells(Zeile + 1, 1), .Cells(Zeile + 1, 1)).Copy
Sheets("Blatt1").Range("I33").PasteSpecial Paste:=xlValues
Range(.Cells(Zeile + 2, 1), .Cells(Zeile + 2, 1)).Copy
Sheets("Blatt1").Range("I32").PasteSpecial Paste:=xlValues

hiermit wird das dazugehörige Datum jeweils in die Zellen I33 und I32 kopiert.

dann Deine:

Range(.Cells(Zeile + 1, 2), .Cells(Zeile + 1, 8)).Copy
Sheets("Blatt1").Range("B33:H33").PasteSpecial Paste:=xlValues
Range(.Cells(Zeile + 2, 2), .Cells(Zeile + 2, 8)).Copy
Sheets("Blatt1").Range("B32:H32").PasteSpecial Paste:=xlValues

Das klappt auch alles wunderbar, nur die Zellen, in denen das Datum reinkopiert wird sind zu klein und es erscheint nur ##.
Ich kann die Zellen aber auch nicht vergrößern, weil sonst das Tabellenformat nicht mehr stimmt.
Mit Zellen verbinden habe ich es auch schon probiert, dann erscheint aber eine Fehlermeldung, daß alle verbundenen Zellen gleich groß müssen.

Wie kann man Abhilfe schaffen?

Gruß Novato

 

Hallo!

Wenn die Zellen zu klein sind, dann hilft nur eines:
Mach sie größer!
Ein Kombi passt nun mal nicht in die Parklücke eines Smarts...

 

Hallo Schatzi,

ein guter Vergleich.


Hast Du auch eine Idee zu meinem Thread

"Zellen die Zahlen enthalten automatisch mit Linien verbinden" ?

Oder läßt sich so etwas gar nicht machen?

Wäre echt nett, wenn Du mir dort antworten könntest


Gruß Novato