Makrofehler

Sub CopyActiveFile()
Application.EnableEvents = False
Dim wbAktiv As Workbook, vNewName As Variant, sInitialName As String
Set wbAktiv = ActiveWorkbook
'Vorgabe für neuen Namen generieren
sInitialName = "Neu " & Left(wbAktiv.Name, InStrRev(wbAktiv.Name, ".") - 1)
'Dialog zur Eingabe/Auswahl des Dateinamens anzeigen
vNewName = Application.GetSaveAsFilename(InitialFileName:=sInitialName, _
Filefilter:="Excel (*.xls;*.xlsx;*.xlsm;*.xlsb),*.xls;*.xlsx;*.xlsm;*.xlsb", _
Title:="Bitte neuen Dateinamen eingeben/auswählen")
If vNewName = False Then GoTo Beenden 'Dialog wurde abgebrochen
'Neuen Namen mit Name der aktiven Datei vergleichen
If UCase(wbAktiv.FullName) = UCase(vNewName) Then
MsgBox "Als neuer Name wurde der Name der aktiven Datei gewählt. " & vbLf _
& "Das ist nicht zulässig!", vbInformation + vbOKOnly
GoTo Beenden
End If
If Dir(vNewName)  "" Then
If MsgBox("Eine Datei mit dem ausgewählten Namen existiert bereits. " & vbLf _
& "Datei """ & vNewName & """ überschreiben?", _
vbQuestion + vbOKCancel + vbDefaultButton2) = vbCancel Then
GoTo Beenden
End If
End If
'Kopie der Datei unter dem neuen Namen speichern
wbAktiv.SaveCopyAs Filename:=vNewName
'Kopie öffnen
Set wbAktiv = Workbooks.Open(Filename:=vNewName)
'Blatt 200 aktivieren und Namen in B1 eintragen
With wbAktiv
Worksheets(200).Activate
Range("A2") = 2
End With
Beenden:
If Range("A2") = 2 Then
Dim NeuerName As String, liSuche As Integer, lboShName As Boolean
Range("A2") = ""
Do Until lboShName = True
NeuerName = InputBox("Bitte geben Sie den neuen Namen des Blattes ein!")
If NeuerName = "" Then Exit Sub
lboShName = True
For liSuche = 1 To Sheets.Count
If LCase(NeuerName) = LCase(Sheets(liSuche).Name) Then
MsgBox "Blattname schon vorhanden"
lboShName = False
Exit For
End If
Next
Loop
ThisWorkbook.ActiveSheet.Copy after:=Sheets(Sheets.Count)
'Sheets ("Eingabe") .Copy After:=Sheets(i)
ActiveSheet.Name = NeuerName
With ActiveSheet.UsedRange
.Value = .Value
End With
Dim lngCol As Long
For lngCol = Columns("C:C").Column To Columns("O:O").Column Step 4
Tabelle200.Range(Tabelle200.Cells(1, lngCol - 1), Tabelle200.Cells(48, lngCol - 1)).Value  _
_
= ActiveSheet. _
Range(ActiveSheet.Cells(1, lngCol), ActiveSheet.Cells(48, lngCol)).Value
Next
End If
Application.EnableEvents = True
End Sub