Lange Formel in Zelle eintragen lassen
21.03.2017 17:23:48
Denis
ich bin neu hier und habe durch dieses Forum schon einige meiner Probleme in VBA durch lesen beheben können. Dafür erstmal Danke!!!
Ich habe jetzt ein Problem, das ich nicht beheben kann...
Ich möchte aus Excel-"Leerblatt" die Excel-"Übersicht" öffnen (wenn nicht offen - wird geöffnet) und in dieser "Übersicht" in die nächste freie Spalte eine Formel in Abhängigkeit vom Namen des Tabellenblatt aus Leerblatt eintragen lassen. Das funktioniert soweit, bis die Formel eingetragen wird. Da bringt er Laufzeitfehler '1004': Anwendungs- oder objektdefinierter Fehler
Hier das Makro:
Sub Tabelleumbenennen()
ThisWorkbook.Sheets(1).Name = Replace(ThisWorkbook.Name, ".xlsm", "")
Dim Range As Range
Dim sPfad As String
Dim x As Integer
Dim z As Integer
y = ThisWorkbook.Sheets(1).Name
sPfad = "Z:\Förster\Förster Stücklisten\Förster Übersicht.xlsm"
ActiveWorkbook.UpdateLinks = xlUpdateLinksAlways
If DateiGeoeffnet(sPfad) = False Then
Workbooks.Open Filename:=sPfad
z = Workbooks("Förster Übersicht.xlsm").Sheets("Übersicht").UsedRange.Columns.Count
x = Workbooks("Förster Übersicht.xlsm").Sheets("Übersicht").UsedRange.Columns.Count + 1
Sheets("Übersicht").Select
Sheets("Übersicht").Range(Cells(2, z), Cells(3, z)).Select
Selection.Copy
Sheets("Übersicht").Select
Sheets("Übersicht").Range(Cells(2, x), Cells(3, x)).Select
ActiveSheet.Paste
Else
Workbooks("Förster Übersicht.xlsm").Activate
z = Workbooks("Förster Übersicht.xlsm").Sheets("Übersicht").UsedRange.Columns.Count
x = Workbooks("Förster Übersicht.xlsm").Sheets("Übersicht").UsedRange.Columns.Count + 1
Sheets("Übersicht").Select
Sheets("Übersicht").Range(Cells(2, z), Cells(3, z)).Select
Selection.Copy
Sheets("Übersicht").Select
Sheets("Übersicht").Range(Cells(2, x), Cells(3, x)).Select
ActiveSheet.Paste
End If
Cells(2, x) = "Abgerufen von " & y
Cells(3, x).FormulaLocal = "=WENN(ISTNV(SVERWEIS([@[Teilenr.]],'Z:\Förster\Förster Stücklisten\[" & y & ".xlsm]" & y & "'!$C$6:$T$200,17,0)),""" - """,SVERWEIS([@[Teilenr.]],'Z:\Förster\Förster Stücklisten\[" & y & "]" & y & "'!$C$6:$T$200,17,0))"
With ActiveWorkbook.VBProject
.VBComponents.Remove .VBComponents("Modul2")
End With
End Sub
Private Function DateiGeoeffnet(DerPfad As String) As Boolean
On Error Resume Next
Open DerPfad For Binary Access Read Lock Read As #1
Close #1
If Err.Number 0 Then
DateiGeoeffnet = True
Err.Clear
End If
End Function