Hallo zusammen,
Ich habe ein Makro geschrieben, mit welchem jeweils via Button eine neue Spalte eingefügt wird.
Über den Button Spalten entfernen wird die jeweils ausgewählte Spalte gelöscht.
Private Sub CmdSpaltePlus_Click() 'Test Spalte hinzufügen
Dim spalte, zeile As Integer
Application.ScreenUpdating = False
spalte = 4
Do Until Cells(2, spalte).Value = "Perfektion"
spalte = spalte + 1
Loop
Columns("D:E").Copy
Columns(spalte).Insert Shift:=xlToRight
Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge
Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge
Cells(3, spalte).Value = ""
Cells(3, spalte + 1).Value = ""
Cells(4, spalte).Value = ""
Cells(4, spalte + 1).Value = ""
zeile = 6
Do Until zeile = 1000
If Left(Cells(zeile, 1).Value, 1) = "S" Then
Cells(zeile, spalte).Value = ""
Cells(zeile, spalte + 1).Value = ""
End If
zeile = zeile + 1
Loop
Application.ScreenUpdating = True
End Sub
Private Sub CmdPerfektionPlus_Click() 'Perfektion Spalte hinzufügen
Dim spalte, zeile As Integer
Application.ScreenUpdating = False
spalte = 4
Do Until Cells(2, spalte).Value = "F.n.B."
spalte = spalte + 1
Loop
Columns("D:E").Copy
Columns(spalte).Insert Shift:=xlToRight
Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge
Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge
Cells(3, spalte).Value = ""
Cells(3, spalte + 1).Value = ""
Cells(4, spalte).Value = ""
Cells(4, spalte + 1).Value = ""
zeile = 6
Do Until zeile = 1000
If Left(Cells(zeile, 1).Value, 1) = "S" Then
Cells(zeile, spalte).Value = ""
Cells(zeile, spalte + 1).Value = ""
End If
zeile = zeile + 1
Loop
Application.ScreenUpdating = True
End Sub
Spalten löschen
Private Sub Kompetenzenentfernen_Click() 'Spalten löschen
ActiveSheet.Unprotect Password:="MNPS"
If Cells(5, ActiveCell.Column) = "Schicht" Or Cells(5, ActiveCell.Column) = "Nr." Or Cells(5, ActiveCell.Column) = "Name" Or Cells(3, ActiveCell.Column) = "A1" Or Cells(3, ActiveCell.Column) = "D1" Or Cells(9, ActiveCell.Column) = "." Or Cells(3, ActiveCell.Column) = "E1" Or Cells(3, ActiveCell.Column) = "F1" Or Cells(3, ActiveCell.Column) = "G1" Or Cells(3, ActiveCell.Column) = "H1" Or Cells(2, ActiveCell.Column) = "." Or Cells(1, ActiveCell.Column) = "Zielwert" Then
MsgBox "Spalte kann nicht gelöscht werden"
Else
Selection.EntireColumn.Delete Shift:=xlUp
End If
'ActiveSheet.Protect Password:="MNPS"
End Sub
Die Buttons funktionieren auch alle, nur leider kommt oft eine Laufzeitfehlerneldung oder das ganze Programm hängt sich auf wenn ich erst mit dem einen Button eine Spalte eingefügt habe und im Anschluss mit dem anderen Button eine Spalte einfügen.
Es funktioniert also leider nicht verlässlich. Hat jemand eine Idee woran das liegen könnte?
Vielen Dank im Voraus!
