Hallo Rudi!
Hier ist das Hauptmakro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long, wsB As Worksheet ', wsD As Worksheet
Dim TB4
'Set TB3 = Workbooks("Masterfile.xls").Sheets("Tabelle1") ' Die sichtbare
Set TB4 = Workbooks("Positionsnummern mit Vorschlag RF-Zuordnung_050907.xls").Sheets(" _
Tabelle1") ' Die unsichtbare
Dim efz1&, k As Range
If Target.Column = 1 And Target.Row > 1 Then
With Worksheets("tabelle1")
efz1 = .Cells(Rows.Count, 4).End(xlUp).Row + 1
.Cells(efz1, 4).Value = Target
End With
End If
Dim efz2&, m As Range
If Target.Column = 4 And Target.Row > 1 Then
With Worksheets("tabelle1")
efz2 = .Cells(Rows.Count, 6).End(xlUp).Row + 1
.Cells(efz2, 6).Value = Target
End With
End If
Dim efz3&, n As Range
If Target.Column = 7 And Target.Row > 1 Then
With Worksheets("tabelle1")
efz3 = .Cells(Rows.Count, 8).End(xlUp).Row + 1
.Cells(efz3, 8).Value = Target
End With
End If
Dim efz4&, p As Range
If Target.Column = 2 And Target.Row > 1 Then
With Worksheets("tabelle1")
efz4 = .Cells(Rows.Count, 5).End(xlUp).Row + 1
.Cells(efz4, 5).Value = Target & " - " & Target.Offset(0, 1)
End With
End If
Dim efz5&, t As Range
If Target.Column = 5 And Target.Row > 1 Then
With Worksheets("tabelle1")
efz5 = .Cells(Rows.Count, 7).End(xlUp).Row + 1
.Cells(efz5, 7).Value = Target & " " & Target.Offset(0, 1)
End With
End If
Dim efz6&, u As Range
If Target.Column = 8 And Target.Row > 1 Then
With Worksheets("tabelle1")
efz6 = .Cells(Rows.Count, 9).End(xlUp).Row + 1
.Cells(efz6, 9).Value = Target & " " & Target.Offset(0, 1)
End With
End If
Dim w As Long
If Target.Column = 7 And Target.Row > 1 Then
If Target.Count = 1 Then
w = Target.Row
Range(Cells(w, 1), Cells(w, 1)).Copy _
Range(Cells(w, 1), Cells(w, 1))
Range(Cells(w, 2), Cells(w, 2)).Copy _
Range(Cells(w, 2), Cells(w, 2))
Range(Cells(w, 4), Cells(w, 4)).Copy _
Range(Cells(w, 4), Cells(w, 4))
Range(Cells(w, 5), Cells(w, 5)).Copy _
Range(Cells(w, 5), Cells(w, 5))
Range(Cells(w, 8), Cells(w, 8)).Copy _
Range(Cells(w, 8), Cells(w, 8))
End If
End If
If Target.Column = 7 Then
Dim loLetzte As Long
With Worksheets("tabelle1")
loLetzte = .Cells(Rows.Count, 10).End(xlUp).Row
.Range("J" & loLetzte + 1 & ":M" & loLetzte + 1).Value = _
.Range("J" & loLetzte & ":M" & loLetzte).Value
.Range("O" & loLetzte + 1 & ":Z" & loLetzte + 1).Value = _
.Range("O" & loLetzte & ":Z" & loLetzte).Value
End With
Application.Run (Workbooks("Masterprog.xla").Name & "!Loesch_Kapitel") 1 Then
With TB4
efz10 = TB4.Cells(Rows.Count, 3).End(xlUp).Row + 1
TB4.Cells(efz10, 3).Value = Target '& " " & Target.Offset(0, 1)
End With
End If
If Target.Column = 6 And Target.Row > 1 Then
With TB4
efz11 = TB4.Cells(Rows.Count, 4).End(xlUp).Row + 1
TB4.Cells(efz11, 4).Value = Target '& " " & Target.Offset(0, 1)
End With
End If
If Target.Column = 9 And Target.Row > 1 Then
With TB4
efz12 = TB4.Cells(Rows.Count, 5).End(xlUp).Row + 1
TB4.Cells(efz12, 5).Value = Target '& " " & Target.Offset(0, 1)
End With
End If
If Target.Column = 7 And Target.Row > 1 Then
If Target.Count = 1 Then
x = Target.Row
Range(Cells(x, 3), Cells(x, 3)).Copy _
Range(Cells(x, 3), Cells(x, 3))
Range(Cells(x, 6), Cells(x, 6)).Copy _
Range(Cells(x, 6), Cells(x, 6))
Range(Cells(x, 9), Cells(x, 9)).Copy _
Range(Cells(x, 9), Cells(x, 9))
End If
End If
End Sub
hier das zweite Makro:
Sub Loesch_Kapitel()
'On Error GoTo WEITER:
Dim mldg, stil, titel, grc
'Dim wks As Worksheet
'Dim wks9 As Worksheet
'Set wks9 = Workbooks("Positionsnummern mit Vorschlag RF-Zuordnung_050907.xls").Worksheets("Tabelle1")
'Set wks = Workbooks("Masterfile.xls").Worksheets("Tabelle1")
'hier wird meldung erzeugt ob daten geändert werden sollen
mldg = "Ist der Abschnitt-, Kapitel-, Subkapiteleintrag korrekt"
stil = vbYesNo + vbCritical + vbDefaultButton2
titel = "Frage ?"
grc = MsgBox(mldg, stil, titel)
If grc = vbYes Then
Exit Sub
Else
If grc = vbNo Then
Call Del_Kapitel
End If
End If
End Sub
und dann das dritte Makro:
Sub Del_Kapitel()
Dim mldg, stil, titel, grc
Dim wks As Worksheet
Dim wks9 As Worksheet
Set wks9 = Workbooks("Positionsnummern mit Vorschlag RF-Zuordnung_050907.xls").Worksheets("Tabelle1")
Set wks = Workbooks("Masterfile.xls").Worksheets("Tabelle1")
mldg = "Wert wirklich löschen ?"
stil = vbYesNo + vbCritical + vbDefaultButton2
titel = "Frage ?"
grc = MsgBox(mldg, stil, titel)
If grc = vbYes Then
Else
Exit Sub
End If
Dim loLetzte As Long
With wks
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 4)), _
.Cells(.Rows.Count, 4).End(xlUp).Row, .Rows.Count)
If IsEmpty(.Cells(loLetzte, 1)) Then
.Range(.Cells(loLetzte, 4), .Cells(loLetzte, 13)).ClearContents
.Range(.Cells(loLetzte, 15), .Cells(loLetzte, 26)).ClearContents
End If
End With
With wks9
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 3)), _
.Cells(.Rows.Count, 3).End(xlUp).Row, .Rows.Count)
If IsEmpty(.Cells(loLetzte, 1)) Then
.Range(.Cells(loLetzte, 3), .Cells(loLetzte, 5)).ClearContents
'.Range(.Cells(loLetzte, 15), .Cells(loLetzte, 26)).ClearContents
End If
End With
Sheets("Kapitel").Range("G2").End(xlDown).Select
'WEITER:
End Sub
zu
mach grc zu einer Public-Variablen und frage sie in der aufrufenden Routine ab.
Wo müßte ich hier bitte Public Variable machen und in welcher Routine?
Danke
Josef