Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
720to724
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
720to724
720to724
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Ereignis: nicht zusammenhängenden Bereich kopieren

Ereignis: nicht zusammenhängenden Bereich kopieren
19.01.2006 20:57:18
Peter
Hallo,
ich „pack“ das nicht allein und würde mich über Hilfe sehr freuen..
Danke im voraus
Peter
Ich habe folgendes Problem:
Wenn in die aktuelle Monatstabelle in eine Spalte die größer als 7 ist,
ein Eintrag erfolgt, möchte ich per Ereignis:
- den Zeilenbereich von Spalte 1-6 und
- die Spalten der aktiven Spalte mit den rechts daneben befindlichen 2 Spalteneinträgen
unter den letzten Eintrag in der Tabelle „Gesamt“ einfügen.
- Wenn möglich sollten der Eintrag in der Tabelle gesamt so erfolgen, dass
Die 9 Spalteneinträge nebeneinanderliegen.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim intMonat As Integer
Dim intJahr As Integer
Dim ShQ
Dim ShZ
Dim LRow
intMonat = Month(Date)
intJahr = Year(Date)
Set ShZ = Sheets("Gesamt")
LRow = ShZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
If Sh.Name = Format(DateSerial(intJahr, intMonat, 1), "mmm YYYY") Then
'If Sh.Target.Row > 8 And Sh.Target.Column > 7 Then
'   ShZ.Range(ShZ.Cells(LRow, 1), ShZ.Cells(LRow, 6)) = _
'   Sh.Range(Sh.Cells(Target.Row, 1), Sh.Cells(Target.Row, 6))
'End If
Else
Exit Sub
End If
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Ereignis: Change mit Function Union
22.01.2006 22:31:59
Uwe
Hallo Peter,
benutze dazu das Change-Ereignis, wenn die Kopie nach einer Eingabe gemacht werden soll.
Mit der Union-Funktion lassen sich mehrere nichtzusammenhängende Bereiche zusammenfassen.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngT As Range
Set rngT = Target.Cells(1)
If Sh.Name = Format(DateSerial(Year(Date), Month(Date), 1), "mmm YYYY") Then
If Not IsEmpty(rngT) Then
If rngT.Row > 8 And rngT.Column > 7 Then
Set rngT = Application.Union(Sh.Range(Sh.Cells(rngT.Row, 1), Sh.Cells(rngT.Row, 6)), Sh.Range(rngT, rngT.Offset(0, 2)))
rngT.Copy Worksheets("Gesamt").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
End If
End If
End Sub

Gruß Uwe
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige