Hallo Zusammen ich habe ein Problem und zwar muss ich ein Command Button erstellen damit ich eine Mitarbeier/in von Liste löschen kann. exel hat viele Tabelle und ich will dass wenn ich eine Name eingene die von jede tabelle gelöscht wird. fürs mitarbeiter/in einfügen habe ich schön ne Button und Code sieht so aus:
Sub Employee()
Application.ScreenUpdating = False
Sheets(„Blank“).Visible = True
Sheets(„Mitarbeiterliste“).Select
k = 0 'This is the number of filled cells between „Begin der Liste“ and „Anzahl Mitarbeiter“
n = 1 'Looping variable
Do Until Worksheets(„Mitarbeiterliste“).Cells(n, 1).Value = „Beginn der Liste“
n = n + 1
Loop 'Search for „Begin der Liste“
n = n + 1 'The next one can be the first name
Do Until Worksheets(„Mitarbeiterliste“).Cells(n, 1).Value = „Anzahl Mitarbeiter“
If Worksheets(„Mitarbeiterliste“).Cells(n, 1).Value Empty Then
k = k + 1 'If the cell is filled, the number is increasing
End If
n = n + 1
Loop
'…NEW EMPLOYEE START
If Worksheets(„INPUT“).Cells(2, 1).Value Empty Then
'…Urlaub,Marketing,Weiterbildung
Do Until ActiveSheet.Name = „Ende“
wsname = ActiveSheet.Name
If (ActiveSheet.Name = „Mitarbeiterliste“) Or (ActiveSheet.Name = „Marketing, Vorträge etc.“) Or (ActiveSheet.Name = „Urlaub“) Or (ActiveSheet.Name = „Weiterbildung“) Or (ActiveSheet.Name = „Blank“) Then
tc = n - 1
lr = n + 1
Rows(n & „:“ & n).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets(„INPUT“).Select
Range(„A2“).Select
Selection.Copy
Sheets(wsname).Select
Range(„A“ & n).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(tc, 2).Select
Selection.AutoFill Destination:=Range(Cells(tc, 2), Cells(n, 2)), Type:=xlFillDefault
Range(Cells(tc, 2), Cells(n, 2)).Select
Range(Cells(tc, 1), Cells(tc, 55)).Select
Selection.Copy
Range(Cells(n, 1), Cells(n, 55)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells(lr, 1).Select
End If
ActiveSheet.Next.Select
Loop
'…Urlaub,Marketing,Weiterbildung… is ready
Sheets(„Beginn Projekte >>“).Select 'Projectsheets
ActiveSheet.Next.Select
Do Until ActiveSheet.Name = " Empty Then
k = k + 1 'If the cell is filled, the number is increasing
End If
n = n + 1
Loop
'… The number or employyes is refreshed
lastRow = n - 1
tocopy = n - 2
Sheets(„Mitarbeiterübersicht“).Select 'Mitarbeiterübersicht
Rows(lastRow & „:“ & lastRow).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets(„INPUT“).Select
Range(„A2“).Select
Selection.Copy
Sheets(„Mitarbeiterübersicht“).Select
Range(„A“ & lastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(„A“ & tocopy).Select
Application.CutCopyMode = False
Selection.Copy
Range(„A“ & lastRow).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range(Cells(tocopy, 2), Cells(tocopy, 55)).Select
Selection.AutoFill Destination:=Range(Cells(tocopy, 2), Cells(lastRow, 55)), Type:=xlFillDefault
Cells(n, 1).Select
'…Mitarbeiterübersicht is ready
Calculate
endlist = k + 6 - 1
Sheets(„Einzelne Mitarbeiter“).Select
Range(„A6“).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=("=Mitarbeiterliste!$A$6:blush:A$" & endlist) 'Add every name to the list
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = „“
.ErrorTitle = „“
.InputMessage = „“
.ErrorMessage = „“
.ShowInput = True
.ShowError = True
End With
Worksheets(„INPUT“).Cells(2, 1).ClearContents
End If
'…NEW EMPLOYEE END
Worksheets(„Mitarbeiterliste“).Cells(n, 2).Value = k 'Refresh the number of employees
Sheets(„Mitarbeiterliste“).Select
Sheets(„Blank“).Visible = False
Application.ScreenUpdating = True
End Sub
Sub Project()
Sheets(„Projektliste“).Select
Application.ScreenUpdating = False
Sheets(„Blank“).Visible = True
Sheets(„Projektliste“).Select
k = 0 'This is the number of filled cells between „Begin der Liste“ and „Anzahl Projekte“
n = 1 'Looping variable
Do Until Worksheets(„Projektliste“).Cells(n, 1).Value = „Beginn der Liste“
n = n + 1
Loop 'Search for „Begin der Liste“
n = n + 1 'The next one can be the first name
Do Until Worksheets(„Projektliste“).Cells(n, 1).Value = „Anzahl Projekte“
If Worksheets(„Projektliste“).Cells(n, 1).Value Empty Then
k = k + 1 'If the cell is filled, the number is increasing
End If
n = n + 1
Loop
If Worksheets(„INPUT“).Cells(2, 6).Value Empty Then 'New project
Rows(n & „:“ & n).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets(„INPUT“).Select
Range(„F2“).Select
Selection.Copy
Sheets(„Projektliste“).Select
Range(„A“ & n).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Do Until Worksheets(„Projektliste“).Cells(n, 1).Value = „Anzahl Projekte“
If Worksheets(„Projektliste“).Cells(n, 1).Value Empty Then
k = k + 1 'If the cell is filled, the number is increasing
End If
n = n + 1
Loop
Worksheets(„INPUT“).Cells(2, 6).ClearContents ’ Clear the INPUT sheet
End If
Worksheets(„Projektliste“).Cells(n, 2).Value = k
Cells(n, 1).Select
k = 0 'This is the number of filled cells between „Begin der Liste“ and „Anzahl Projekte“
n = 1 'Looping variable
Do Until Worksheets(„Projektliste“).Cells(n, 1).Value = „Beginn der Liste“
n = n + 1
Loop 'Search for „Begin der Liste“
n = n + 1 'The next one can be the first project
Do Until Worksheets(„Projektliste“).Cells(n, 1).Value = „Anzahl Projekte“
If Worksheets(„Projektliste“).Cells(n, 1).Value Empty Then
k = k + 1 'If the cell is filled, the number is increasing
End If
n = n + 1
Loop
Worksheets(„Projektliste“).Cells(n, 2).Value = k
i = 6
Sheets(„Beginn Projekte >>“).Select
Do Until Worksheets(„Projektliste“).Cells(i, 1).Value = Empty Or Worksheets(„Projektliste“).Cells(i, 1).Value = „Anzahl Projekte“
ActiveSheet.Next.Select
If ActiveSheet.Name = „>“).Select
ActiveSheet.Next.Select
i = 1
Do Until ActiveSheet.Name = " 0 Then
Worksheets(„Einzelne Mitarbeiter“).Cells(i + 10, 1).Value = ActiveSheet.Name
i = i + 1
End If
j = j + 1
Loop
ActiveSheet.Next.Select
Loop
Sheets(„Einzelne Mitarbeiter“).Select
lastRow = i + 9
If lastRow > 10 Then
Range(„C10:BC10“).Select
Selection.AutoFill Destination:=Range(Cells(10, 3), Cells(lastRow, 55)), Type:=xlFillDefault
End If
Cells(1, 1).Select
Calculate
Worksheets(„Einzelne Mitarbeiter“).Cells(6, 1).Select
Sheets(„Blank“).Visible = False
Application.ScreenUpdating = True
End Sub
WENN jemand mir helfen könnte were nett