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

Ergebnis variabel einfügen

Forumthread: Ergebnis variabel einfügen

Ergebnis variabel einfügen
04.10.2007 21:17:29
Wolfgang
Hallo,
den untenstehenden Code habe ich in Recherche entdeckt; er bewirkt wohl offensichtlich, das das gesuchte Ergebnis aus der Tabelle Inhalt in die Tabelle Ergebnis eingefügt wird. Hierbei wird, wenn ich das richtig interpretiere, der Zellbereich C6/C7 angesprochen. Wie müßte der Code geändert werden, wenn schon beispielweise Text in C6 (Stichwort) und C7 (Text zum Stichwort) steht, damit dieser nicht gelöscht wird, sondern der neue Text in C8/C9 usw. eingefügt wird? - Also, Excel eigentlich in einem vorbestimmten Bereich z.B. C6 bis C26 die nächste freie Zelle sucht und darin den jeweiligen Text einfügt? - Wenn C26 dann erreicht ist, eine MsgBox. mit dem Hinweis erfolgt? - Danke schon jetzt allen wieder für die Rückmeldung.
Herzliche Grüße
Wolfgang

Sub Ergebnis()
Application.ScreenUpdating = False
j = 0
Sheets("Ergebnis").Select
ActiveSheet.Unprotect ("a21")
Range("C:C").ClearContents
Sheets("Inhalt").Select
ActiveCell.Offset(0, 0).Range("a1").Select
Selection.Copy
Sheets("Ergebnis").Select
Range("C6").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("a1").Select
Sheets("Inhalt").Select
Do
ActiveCell.Offset(1, 0).Range("a1").Select
Selection.Copy
Sheets("Ergebnis").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("a1").Select
Sheets("Inhalt").Select
If ActiveCell.FormulaR1C1 = "" Then j = j + 1
Loop While j 


Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ergebnis variabel einfügen
04.10.2007 23:45:00
Worti
Hallo Wolfgang,
hab den Code mal ein wenig entfrachtet und wenn du noch auf ActiveCell verzichten kannst, kann man das Sheets("Inhalt").Select und die beiden Application.ScreenUpdating-Anweisungen auch noch eliminieren. Hier mal der Code, so wie ich ihn verstandne habe, ergänzt um die von dir gewünschte Flexibilität:


Sub Ergebnis()
    Dim rngBereich As Range
    Dim lngZeile As Long
    Application.ScreenUpdating = False
    Sheets("Inhalt").Select
    Sheets("Ergebnis").Unprotect ("a21")
    'Sheets("Ergebnis").Range("C:C").ClearContents <-- auskommentieren, sonst ist der Bereich immer leer
    Set rngBereich = Sheets("Ergebnis").Range("C6:C25") '<--hier deinen Wunschbereich hin
    lngZeile = rngBereich.Row
    Do
      lngZeile = lngZeile + 1
    Loop Until Sheets("Ergebnis").Cells(lngZeile, rngBereich.Column) = "" Or _
         lngZeile > rngBereich.Row + rngBereich.Rows.Count
    If lngZeile < rngBereich.Row + rngBereich.Rows.Count - 1 Then
       Sheets("Ergebnis").Range("C" & lngZeile) = ActiveCell.Value
       Sheets("Ergebnis").Range("C" & lngZeile + 1) = ActiveCell.Offset(1, 0).Value
       Sheets("Ergebnis").Range("C" & lngZeile + 2) = ActiveCell.Offset(2, 0).Value
    Else
       MsgBox "Zu füllender Bereich ist schon voll!"
    End If
    Sheets("Ergebnis").Protect ("a21")
    Application.ScreenUpdating = True
End Sub


Gruß WOrti

Anzeige
Danke Worti - klappt super !
05.10.2007 05:26:00
Wolfgang
Hallo Worti,
herzlichen Dank für Deine Ausarbeitungen. Das klappt wunderbar. Ich freue mich sehr. Weiterhin alles Gute!
Herzliche Grüße
Wolfgang
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige