So I wrote a makro, which inserts a new Column in every worksheet except the first. It works just fine. My only problem is, that I would like it to jump back to the sheet I started at after finishing up the last worksheet. All solutions I found online said, that the line: Sheets("Name of Sheet").Select should do the deed. However it doesn't do it for me. What am I doing wrong? I would also appreciate suggestions to improve the code.
Option Explicit
Sub NeueSpalte()
Dim ende As Boolean
Dim Name As Variant
Dim Anzahl_WS As Integer
Dim Zaehler As Integer
Do While ende = False
Name = InputBox("Name der neuen Spalte")
If StrPtr(Name) = 0 Then
MsgBox ("Abgebrochen!")
Exit Sub
ElseIf Name = "" Then
MsgBox ("Bitte etwas eingeben")
Else
Exit Do
End If
Loop
Anzahl_WS = ActiveWorkbook.Worksheets.Count - 1
Sheets("Rechte auf Verträge der A3").Select
Application.ScreenUpdating = False
For Zaehler = 1 To Anzahl_WS
Cells(1, 2).EntireColumn.Copy
Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Activate
ActiveCell.EntireColumn.Insert
Application.CutCopyMode = False
Cells(1, Columns.Count).End(xlToLeft).Activate
ActiveCell.EntireColumn.Select
Selection.ClearContents
Cells(8, 2).MergeCells = False
Cells(1, Columns.Count).End(xlToLeft).Offset(7, 1).Activate
Range(Cells(8, 2), ActiveCell).MergeCells = True
Cells(8, 2).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Name
If ActiveSheet.Name = "Rechte auf Verträge der WW" Then
Exit Sub
Else
ActiveSheet.Next.Select
End If
Next Zaehler
Application.ScreenUpdating = True
Sheets("Rechte auf Verträge der A3").Select
End Sub
expected result: copy column b into first empty column, delete its contents and insert the user picked name in row 1 of the new column. Do that for every sheet and jump back to sheet number 2
actual result: it does everything just fine, but doesn't jump to sheet 2