ich versuche es so.
folgende Codes
Tabelle3 (Rechnungen)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Alles einblenden
'Spalten
Range("A1:ZZ1").EntireColumn.Hidden = False
'Zeilen
Rows("1:5000").Select
Range("B1").Activate
Selection.EntireRow.Hidden = False
'letzte beschriebene Zeile wählen
Range("B26").Select
Selection.End(xlDown).Select
Rows("1:4").Select
Range("B1").Activate
Selection.EntireRow.Hidden = True
' Doppelclick auf Zeile
Dim wsB As Worksheet
Set wsB = ThisWorkbook.Worksheets("Nachträge")
If Not Intersect(Target, Range("B:FY")) Is Nothing Then
wsB.Unprotect Password:="Sw36988#"
pLRow = Target.Row
UserForm_Nachtrag.Show
End If
Cancel = True
'individuelle Bauteilanzeige
Rows("1:4").Select
Range("B1").Activate
Selection.EntireRow.Hidden = False
'Spalten ausblenden
Dim Suchbereich As Range
Dim rngAusblenden As Range
Dim Fundzelle As Range
Dim strErstFund As String
Set Suchbereich = Range("A1:ZZ1")
Set Fundzelle = Suchbereich.Find("0", LookIn:=xlValues, lookat:=xlWhole)
If Not Fundzelle Is Nothing Then
Set rngAusblenden = Fundzelle
strErstFund = Fundzelle.Address
Do
Set Fundzelle = Suchbereich.FindNext(Fundzelle)
If Fundzelle.Address = strErstFund Then Exit Do
Set rngAusblenden = Application.Union(rngAusblenden, Fundzelle)
Loop
End If
rngAusblenden.EntireColumn.Hidden = True
'Zeilen ausblenden
Dim zeile As Integer
zeile = 6
For zeile = 6 To 25
If Range("b" & zeile).Value = "0" Then '= "0" Then
Rows(zeile).Hidden = True
Else
End If
Next zeile
'letzte beschriebene Zeile wählen
Range("B26").Select
Selection.End(xlDown).Select
Rows("1:4").Select
Range("B1").Activate
Selection.EntireRow.Hidden = True
End Sub
UserForm_Rechnung
Private Sub CommandButton1_Click()
Sheets("Rechnungen").Unprotect Password:="Sw36988#"
Rows("1:5").Select
Selection.EntireRow.Hidden = False
Dim lUpdRow As Long
With Worksheets("Rechnungen")
'Erste freie Zelle in Spalte A oder Zeile die geändert wird und neue Zeile einfügen
If pLRow = 0 Then
lUpdRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim newRow As Long
newRow = Cells(Rows.Count, 5).End(xlUp).Row + 1
Rows("3:3").Copy Cells(newRow, 1)
Application.CutCopyMode = False
Rows("1:4").Select
Selection.EntireRow.Hidden = True
Else
lUpdRow = pLRow
End If
End With
Sheets("Rechnungen").Protect UserInterfaceOnly:=True, Password:="Sw36988#"
'Userform schließen
Unload UserForm_Rechnung
End Sub
_____________
Private Sub UserForm_Initialize()
'Zuweisung Bauteilbezeichnung in Userform
Me.Label13 = Worksheets("Basis").Range("B11").Text
Me.Label14 = Worksheets("Basis").Range("B12").Text
Me.Label15 = Worksheets("Basis").Range("B13").Text
Me.Label16 = Worksheets("Basis").Range("B14").Text
Me.Label17 = Worksheets("Basis").Range("B15").Text
Me.Label18 = Worksheets("Basis").Range("B16").Text
'Drop-Down-Zuweisung ComboBoxen
ComboBox1.List = Worksheets("Basis").Range("E4:E23").Value
ComboBox2.List = Worksheets("SDD").Range("L2:L30").Value
ComboBox3.List = Worksheets("SDD").Range("B2:B30").Value
'Textzuweisung bei neuer Rechnung
ComboBox1 = "Auftragnehmer wählen"
With ThisWorkbook.Worksheets("Rechnungen")
If pLRow = 0 Then
Caption = "NEUE RECHNUNG ANLEGEN:"
'Text- ComboBoxen Grundeintrag
TextBox5 = "0,00"
TextBox11 = "0,00"
TextBox12 = "0,00"
TextBox13 = "0,00"
TextBox14 = "0,00"
TextBox15 = "0,00"
TextBox16 = "0,00"
TextBox17 = "0,00"
TextBox18 = "0,00"
TextBox19 = "0,00"
TextBox20 = "0,00"
TextBox21 = "0,00"
TextBox22 = "0,00"
TextBox26 = "0,00"
TextBox29 = "0,00"
TextBox30 = "0,00"
TextBox32 = "0,00"
Else
Caption = "RECHNUNGSSTATUS AKTUALISIEREN: " & .Cells(pLRow, 2).Text
ComboBox1.Text = .Cells(pLRow, 2).Text
ComboBox2.Text = .Cells(pLRow, 7).Text
ComboBox3.Text = .Cells(pLRow, 6).Text
TextBox1.Text = .Cells(pLRow, 8).Text
TextBox2.Text = .Cells(pLRow, 9).Text
TextBox3.Text = .Cells(pLRow, 10).Text
TextBox4.Text = .Cells(pLRow, 11).Text
TextBox23.Text = .Cells(pLRow, 19).Text
TextBox24.Text = .Cells(pLRow, 104).Text
TextBox5.Text = .Cells(pLRow, 17).Text
TextBox11.Text = .Cells(pLRow, 20).Text
TextBox13.Text = .Cells(pLRow, 29).Text
TextBox14.Text = .Cells(pLRow, 38).Text
TextBox15.Text = .Cells(pLRow, 47).Text
TextBox16.Text = .Cells(pLRow, 56).Text
TextBox12.Text = .Cells(pLRow, 65).Text
TextBox17.Text = .Cells(pLRow, 106).Text
TextBox19.Text = .Cells(pLRow, 114).Text
TextBox20.Text = .Cells(pLRow, 122).Text
TextBox21.Text = .Cells(pLRow, 130).Text
TextBox22.Text = .Cells(pLRow, 138).Text
TextBox18.Text = .Cells(pLRow, 146).Text
TextBox25.Text = .Cells(pLRow, 88).Text
TextBox26.Text = .Cells(pLRow, 89).Text
TextBox29.Text = .Cells(pLRow, 169).Text
TextBox31.Text = .Cells(pLRow, 99).Text
TextBox32.Text = .Cells(pLRow, 100).Text
TextBox30.Text = .Cells(pLRow, 180).Text
TextBox36.Text = .Cells(pLRow, 184).Text
TextBox37.Text = .Cells(pLRow, 185).Text
TextBox38.Text = .Cells(pLRow, 186).Text
End If
End With
End Sub