Makro funktioniert nur in persönlicher Mappe
05.03.2019 13:17:33
Alina
aktuell schreibe ich einen Code mit dem man mehrere Dateien eines Experiments zuerst formatieren und danach auswerten kann.
Leider habe ich nun das Problem, dass dieser Code in meiner persönlichen Mappe super funktioniert, mir in der Projektmappe aber immer ein Fehler angezeigt wird (Laufzeitfehler 1004, Anwendungs- & Objektdefinierter Fehler). In der persönlichen Mappe kann ich den Code aber nicht lassen, weil ich ein Dokument mit Buttons erstellen soll, damit jeder mit Hilfe der erstellten "Buttons-Datei" das Experiment auswerten kann.
Da ich mich leider überhaupt nicht mit VBA auskenne und den Code auch mehr oder weniger zusammengebastelt habe, weiß ich nicht wo ich etwas ändern muss und wäre für jede Hilfe dankbar...
Hier mein Code:
--> der Fehler erscheint immer bei der Zeile Columns("A:A").Select
Sub Auswertung()
Dim xFd As FileDialog
Dim xSPath As String
Dim xCSVFile As String
Dim xWsheet As String
Application.DisplayAlerts = False
Application.StatusBar = True
xWsheet = ActiveWorkbook.name
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Title = "Select a folder:"
If xFd.Show = -1 Then
xSPath = xFd.SelectedItems(1)
Else
Exit Sub
End If
If Right(xSPath, 1) "\" Then xSPath = xSPath + "\"
xCSVFile = Dir(xSPath & "*.xlsx")
Do While xCSVFile ""
Application.StatusBar = "Converting: " & xCSVFile
Workbooks.Open Filename:=xSPath & xCSVFile
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True
Rows("1:4").Select
Selection.Delete Shift:=xlUp
For I = 1 To 100
If Cells(I, "B").Value = "ne" And Cells(I, "C").Value = 11 Then
Cells(I, "E").Value = 1
ElseIf Cells(I, "B").Value = "a" And Cells(I, "C").Value = 11 Then
Cells(I, "E").Value = 0
ElseIf Cells(I, "B").Value = "n" And Cells(I, "C").Value = 11 Then
Cells(I, "E").Value = 0
ElseIf Cells(I, "B").Value = "s" And Cells(I, "C").Value = 11 Then
Cells(I, "E").Value = 0
ElseIf Cells(I, "B").Value = "h" And Cells(I, "C").Value = 11 Then
Cells(I, "E").Value = 0
ElseIf Cells(I, "B").Value = "n" And Cells(I, "C").Value = 10 Then
Cells(I, "E").Value = 0
ElseIf Cells(I, "B").Value = "a" And Cells(I, "C").Value = 10 Then
Cells(I, "E").Value = 1
ElseIf Cells(I, "B").Value = "n" And Cells(I, "C").Value = 10 Then
Cells(I, "E").Value = 1
ElseIf Cells(I, "B").Value = "s" And Cells(I, "C").Value = 10 Then
Cells(I, "E").Value = 1
ElseIf Cells(I, "B").Value = "h" And Cells(I, "C").Value = 10 Then
Cells(I, "E").Value = 1
End If
Next I
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows(xWsheet).Activate
xCSVFile = Dir
Loop
Application.StatusBar = False
Application.DisplayAlerts = True
End Sub
Liebe Grüße
Alina