AW: Kopien mit Makro
17.12.2006 14:57:18
Erich
Hallo Manfred,
das geht mit folgendem Makro (im Code der Arbeitsmappe, gilt für alle Tabellenblätter):
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngF As Range, lngF As Long, lngZ As Long
Select Case Sh.Name
Case "Geschäftsvorfälle Original "
Case "Lies mich"
Case Else
If Intersect(Target(1), Columns(1)) Is Nothing Then Exit Sub
If (Target(1).Row - 2) Mod 3 <> 0 Then Exit Sub
If IsEmpty((Target(1))) Then Exit Sub
With Sheets("Geschäftsvorfälle Original ")
Set rngF = .Columns(1).Find(Target(1))
If rngF Is Nothing Then
MsgBox "Buchungssatz " & Target(1) & " nicht gefunden.", vbCritical, "Abbruch"
Exit Sub
End If
lngF = rngF.Row
lngZ = Target(1).Row
Application.EnableEvents = False
Range(Cells(lngZ, 2), Cells(lngZ, 7)) = _
.Range(.Cells(lngF, 2), .Cells(lngF, 7)).Value
Range(Cells(lngZ + 1, 5), Cells(lngZ + 2, 7)) = _
.Range(.Cells(lngF + 1, 5), .Cells(lngF + 2, 7)).Value
Application.EnableEvents = True
End With
End Select
End Sub
Und hier die Beispielmappe:
https://www.herber.de/bbs/user/39066.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort