Hallo ihr Lieben,
folgenden Vorgang versuche ich seit einer Stunde in VBA umzusetzen:
In einem Tabellenblatt werden die Zellen einer Spalte (E2 - E30) auf Inhalt überprüft. Falls in der Zelle etwas steht, soll der Inhalt der ersten Zelle aus der betreffenden Reihe kopiert und in die erste freie Zeile eines anderen Tabellenblattes kopiert werden.
Der zugehörige Code sieht folgendermaßen aus und macht nicht, was er soll:
Code:
Sub Bes4()
Dim rng As Range
Dim cell As Range
Sheets("K_5").Select
Set rng = Range("E2:E30")
For Each cell In rng
If IsEmpty(cell.Value) = False Then
Cells(ActiveWindow.RangeSelection.Row, 1).Select
Selection.Copy
Sheets("4_Bes").Select
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next
End Sub
Vielen Dank schonmal für eure Hilfe!
HB
Hi,
Blattnamen auf Deine Gegebenheiten anpassen!
Code:
Option Explicit
Sub til()
Dim wksQuell As Worksheet
Dim wksZiel As Worksheet
Dim rngSearch As Range
Dim C As Range
Dim lngRow As Long
Set wksQuell = Worksheets("K_5") 'Quellblatt - anpassen!
Set wksZiel = Worksheets("4_Bes") 'Zielblatt - anpassen!
Set rngSearch = wksQuell.Range("E2:E20")
With wksZiel
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'freie Zeile im Zielblatt anhand Spalte A (1) ermitteln
For Each C In rngSearch
If Len(C) Then
.Cells(lngRow, 1).Value = wksQuell.Cells(C.Row, 1).Value
lngRow = lngRow + 1
End If
Next C
End With
End Sub
Vielen Dank Boris,
funktioniert einwandfrei! :)
Hallo nochmal,
ich bin zum zweiten Mal auf eure Hilfe angewiesen, da sich die Anforderungen geändert haben. Vermutlich ist es am besten, wenn ich das Problem nochmal in seiner Gesamtheit beschreibe. Die Neuerungen habe ich farbig gemacht.
In einem Tabellenblatt werden die Zellen einer Spalte (E2 - E30) auf Inhalt überprüft. Falls in einer der Zellen etwas steht und nicht fett geschrieben ist, soll der Inhalt der ersten Zelle aus der betreffenden Reihe kopiert und in die erste freie Zeile eines anderen Tabellenblattes übertragen werden. In die Zelle rechts daneben soll der Name des Urprungsblattes eingefügt werden und wiederum eine Zelle weiter rechts soll das aktuelle Datum eingefügt werden. Sobald das geschehen ist, soll der Inhalt der Ursprungszelle fett geschrieben werden, damit bei einer erneuten Überprüfung der Wert nicht mehrfach übernommen wird.
Ich hoffe, ich habe das nachvollziehbar beschrieben. Dass der Zelleninhalt auf fett / nicht fett überprüft wird, muss natürlich nicht so umgesetzt werden, falls das anders einfacher geht.
Leider übersteigt das meine bescheidenen VBA-Kenntnisse und Herr Google konnte hier auch nicht mehr helfen...
Schon jetzt vielen Dank für eure Hilfe!
HB
Hallo,
Auswertungen nach Zellformaten sind keine gute Idee.
Hallo Klaus-Dieter,
danke für dein Feedback.
Im Prinzip geht es ja nur darum, dass bereits übernommene Zellenwerte nicht bei jeder Aktivierung des Makros erneut übertragen werden. Gibt es dafür eine andere Möglichkeit als die Änderung und Auswertung des Zellformats?
Viele Grüße
HB
