Sub Formeln_auflisten()
Dim lngZ As Long
Dim wsBlatt As Worksheet
Dim rngFormeln As Range, rngZelle As Range
lngZ = 301
For Each wsBlatt In Worksheets
On Error Resume Next
Set rngFormeln = Nothing
Set rngFormeln = wsBlatt.Range("A1:BZ300").Cells.SpecialCells(xlCellTypeFormulas)
If Not rngFormeln Is Nothing Then
For Each rngZelle In rngFormeln
lngZ = lngZ + 1
Cells(lngZ, 1) = wsBlatt.CodeName
Cells(lngZ, 2) = rngZelle.Address(0, 0)
Cells(lngZ, 3) = "'" & rngZelle.FormulaLocal
Next
End If
Next
If lngZ = 1 Then MsgBox "Keine Formeln im Bereich"
End Sub
Ergebnisauszug
Tabelle2 B4 =DE.NAME($A$1;$A$4;"0157")
Tabelle2 B6 =DE.NAME($A$1;$A$6;"TEURO")
Tabelle2 C6 =DE.NAME($A$1;$A$6;"TLC")
Tabelle2 D6 =DE.NAME($A$1;$A$6;"EURO")
Tabelle2 B8 =DE.NAME($A$1;$A$8;"Yearend/Y2007")
Danach gehe ich in der Datei her und baue mit &-Zeichen den VBA Code zusammen. Sieht dann ungefähr so aus
=$A$295&E303&$A$296&B303&$A$297&$A$298&C303&$A$299
Ergebnis erste Zeile von Bsp.
Sheets(2).Range("B4").FormulaLocal = "=DE.NAME($A$1;$A$4;"0157")"
So dann wollte ich meine 3500 Zeilen so erzeugten Code nehmen und in eine
Sub Formel_einfuegen() packen. Jetzt habe ich aber das duselige Problem mit den Anfü _
hrungszeichen. Einfach Suchen/Ersetzen ist ja nicht. Da werden die ja auch z.B. von der Range mit ersetzt.
Wie bekomme ich nun die oben weggeschriebenen Formlen wieder aufs richtige Tabellenblatt in die _
richtige Zelle?
Beste Grüße
Michael
Option Explicit
Sub Formeln_auflisten()
Dim lngZ As Long
Dim wsBlatt As Worksheet
Dim rngFormeln As Range, rngZelle As Range
lngZ = 1
For Each wsBlatt In Worksheets
On Error Resume Next
Set rngFormeln = Nothing
Set rngFormeln = wsBlatt.Range("A1:C22").Cells.SpecialCells(xlCellTypeFormulas)
If Not rngFormeln Is Nothing Then
For Each rngZelle In rngFormeln
lngZ = lngZ + 1
Cells(lngZ, 10) = wsBlatt.CodeName
Cells(lngZ, 11) = rngZelle.Address(0, 0)
Cells(lngZ, 12).FormulaLocal = rngZelle.FormulaLocal
Next
End If
Next
If lngZ = 1 Then MsgBox "Keine Formeln im Bereich"
End Sub
Private Sub CommandButton1_Click()
Dim LoLetzte As Long
Dim LoI As Long
With Worksheets("Test")
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 10)), .Cells(.Rows.Count, 10).End(xlUp).Row, _
.Rows.Count)
For LoI = 2 To LoLetzte
.Cells(LoI, 10).Range(CStr(.Cells(LoI, 11))).FormulaLocal = .Cells(LoI, 12). _
FormulaLocal
Next LoI
End With
End Sub
Das Makro har noch einen kleinen Fehler bei der Ausführung, er sollte die Formel in C18 ff schreiben er schreibt sie aber in L36FF. Das ist mir jetzt nicht klar. Eigentlich sollte es richtig gehen. Vielleicht hat die Datei einen Fehler. Ich habe jetzt aber keine Zeit das zu vertiefen.
Gruß Hajo
Sub Formeln_auflisten()
Dim lngZ As Long
Dim wsBlatt As Worksheet
Dim rngFormeln As Range, rngZelle As Range
lngZ = 1
For Each wsBlatt In Worksheets
On Error Resume Next
Set rngFormeln = Nothing
Set rngFormeln = wsBlatt.Range("A1:C22").Cells.SpecialCells(xlCellTypeFormulas)
If Not rngFormeln Is Nothing Then
For Each rngZelle In rngFormeln
lngZ = lngZ + 1
Cells(lngZ, 10) = wsBlatt.CodeName
Cells(lngZ, 11) = rngZelle.Address(0, 0)
Cells(lngZ, 12) = "'" & rngZelle.FormulaLocal
Cells(lngZ, 13) = "Sheets(" & Right(wsBlatt.CodeName, Len(wsBlatt.CodeName) - 7) _
& ").Range(""" & rngZelle.Address(0, 0) & """).FormulaLocal = """ & Replace(rngZelle.FormulaLocal, """", """""") & """"
Next
End If
Next
If lngZ = 1 Then MsgBox "Keine Formeln im Bereich"
End Sub