Fehler 1004 bei Import Funktion
NewtonZ4
eigentlich hat alles gefunzt, aber jetzt bekomme ich immer folgende Fehlermeldung.
Bitte um Hilfe...!
Fehler 1004
Die Blätter können von Excel nicht in die Zielarbeitsmappe eingefügt
werden, da sie eine geringere Anzahl von Zeilen und Spalten enthält als
die Quellarbeitsmappe. Zum Verschieben oder Kopieren der Daten in
die Zielarbeitsmappe können Sie die Daten auswählen und dann
mithilfe der Befehle 'Kopieren' und 'Einfügen' in die Blätter einer
anderen Arbeitsmappe einfügen
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub ImportCSP()
Dim objWB As Workbook
Dim strCSP As String, strPath As String, strNewName As String
Dim intC As Integer, lngCalc As Long
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
End With
strPath = "H:\Alarmreports 2011\Import"
strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
strCSP = Dir(strPath & "*.csp", vbNormal)
Do While strCSP ""
intC = 0
Set objWB = Workbooks.Open(strPath & strCSP)
objWB.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
strNewName = strCSP
Do While SheetExist(strNewName)
intC = intC + 1
strNewName = strCSP & "(" & intC & ")"
Loop
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = strNewName
objWB.Close False
strCSP = Dir
Loop
ErrExit:
If Err.Number 0 Then
MsgBox "Fehler:" & vbTab & Err.Number & vbLf & vbLf & Err.Description, vbExclamation, "Fehler"
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = lngCalc
End With
Set objWB = Nothing
End Sub
Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
Dim wks As Worksheet
On Error GoTo ERRORHANDLER
If Wb Is Nothing Then Set Wb = ThisWorkbook
For Each wks In Wb.Worksheets
If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
Next
ERRORHANDLER:
SheetExist = False
End Function