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!
Danke für den Lösungsvorschlag, der bringt mich einen Schritt weiter, aber nicht zur Lösung. Daher hier mein Ansatz.
Private Sub CommandButton1_Click()
Dim Zeile As Long
Zeile = ActiveCell.Row
Rows(Zeile + 1).Insert (xlShiftDown)
Rows(Zeile).Copy Rows(Zeile + 1)
Dim MeineNeueZeile As Integer
ActiveCell.Select
Range("B" & MeineNeueZeile).Value = "u"
End Sub
Die Variante mit Cells funktioniert auch nicht.
Es kommt in der Zeile Range ... immer eine Fehlermeldung.
Ich habe es auch mit einer eigenen Schaltfläche probiert, die auch keine Lösung brachte. Für weitere Vorschläge bin ich sehr dankbar.