Zeilen kopieren, Code läuft mehrfach ab
25.03.2009 09:44:11
Alex
ich habe schon seit Wochen ein Problem bei der Fertigstellung meiner Exceldatei und komm einfach nicht weiter.
Könnt ihr mir dabei helfen?
Per Doppelklick auf eine Zelle in Sheet Übersicht werden Tabellenblätter aufgerufen und
Daten aus (Sheet Grundformular Zeile 16) eingefügt.
Wenn jetzt in Grundformular nicht nur Zeile 16 beschrieben ist, sondern auch Zeile 17 und 18 ist es machbar, dass Excel erkennt wie viele Zeilen beschrieben sind und diese dann nacheinander in das ausgewählte Tabellenblatt einfügt?
Ab dem Code-Teil Daten aus Grundformular kopieren müsste dann entsprechend der Anzahl der in Grundformular beschriebenen Zeilen mehrfach nacheinander ablaufen.
Wie müsste man das denn schreiben?:
Teste ob Grundformular Zelle M16 beschrieben ist,
wenn ja, dann kopiere A16:M16 und füge ein
Teste ob Grundformular Zelle M17 beschrieben ist,
wenn ja, dann kopiere A17:M17 und füge ein
usw. bis nichts mehr gefunden wird.
Habe schon viel recherchiert aber nichts gefunden und ich selbst bin zu schwach in VBA um das zu realisieren brauche es aber so dringend.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ActiveCell.Column = 1 Then
Cancel = True
Sheets(ActiveCell.Row).Visible = True
Sheets(ActiveCell.Row).Activate
If MsgBox(Prompt:="Daten übernehmen?", _
Buttons:=vbYesNo, _
Title:="Daten aus Grundformular kopieren") = vbYes Then
'Daten aus Grundformular kopieren
Worksheets("Grundformular").Range("A16:M16").Copy _
Destination:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
'Zeilennummer anpassen
If IsNumeric(ActiveSheet.Range("A65536").End(xlUp)) Then
ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Value = _
ActiveSheet.Range("A65536").End(xlUp).Value + 1
Else
ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Value = 1
End If
End If
End If
End Sub
Wenn mir dabei jemand Helfen könnte wäre ich sehr froh (häng schon richtig in den Seilen).
Wenn jemand meint es geht so wie ich mir das vorstelle auf gar keinen Fall könnt ihr auch schreiben. Dann weiß ich wenigstens bescheid.
Gruss
Alex