Zeile löschen, Tabellenblatt in andere Mappe
Bowl
Blatt muss an letzte Stelle der anderen Mappe verschoben werden.
Beim löschen der entsprechenden Zeilen (die Zeilen in der in B der Blattname des verschobenen Sheets bzw der Wert aus B3 der verschobenen Sheets) muss die Zeile gelöscht werden/oder der Inhalt, darunterliegendes Zeug um eins nach oben verschoben werden und am besten eine Zeile vor der Zeile 70 wieder eingefügt werden (damit die Summen die in Zeile 70 stehen wirklich erst in Zeile 70 stehen und nicht mit der Zeit immer weniger Platz für neue eintragungen bliebt)
Die Buttons auf dem Tabellenblatt, dass kopiert wird müssen gelöscht werde
Code:
Sub auftragloeschen()
Dim WS As Worksheet
Dim y, i As Integer
Dim tmp As Long
Application.ScreenUpdating = False
If MsgBox("Das Löschen hätte zur Folge, dass dieser Auftrag in der Gesamtplanung nicht mehr _
Berücksichtigt werden würde." & vbCrLf & "Dieses Planungsblatt würde in die Datei Archiv verschoben werde" & vbCrLf & "Wirklich entfernen?", vbQuestion + vbOKCancel) = vbOK Then
tmp = ActiveSheet.Cells(3, 2).Value
Application.DisplayAlerts = False
Dim myShape As Shape
For Each myShape In ActiveSheet.Shapes
myShape.Delete
Next
ChDir _
"C:\xyc\Planung 1"
Workbooks.Open Filename:= _
"C:xyc\Planung 1\Archiv.xls"
Windows("Auftragsplanung.xls").Activate
Sheets(tmp).Select
ActiveSheet.Move After:=Workbooks("Archiv.xls").Sheets(i)
ActiveWorkbook.Save
ActiveWindow.Close
Windows("Auftragsplanung.xls").Activate
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Vorlage").Select
ActiveWorkbook.Save
Application.DisplayAlerts = True
For Each WS In Worksheets
If InStr(WS.Name, "A_") = 1 Then
With WS
For y = 10 To .Cells(.Rows.Count, 2).End(xlUp).Row '200
If .Cells(y, 2) = tmp Then
.Unprotect
.Rows(y).Delete
.Rows(70).Select
Selection.Insert Shift:=xlDown
Exit For
End If
Next y
End With
End If
Next WS
End If
Application.ScreenUpdating = True
Sheets("Vorlage").Activate
Sheets("Vorlage").TextBox1.Value = ""
End
Sub
Anzeige