Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1492to1496
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro Wertkopie

Makro Wertkopie
24.05.2016 12:58:54
Martin
Mahlzeit zusammen,
ich habe folgendes Makro, welches mir bestimmte Formeln in einem Registerblatt wertkopiert. Nun möchte ich das Ganze erweitert haben, dass das Makro alle Register einer Arbeitsmappe durchläuft bzw. im Idealfall wäre es perfekt, wenn nach dem Starten eine Abfrage kommt, ob nur das aktuelle Register oder die gesamte Mappe bearbeitet werden soll. Könnt ihr mir weiterhelfen?
Danke im Voraus:
Sub Wertkopie_DBR_DBS_TM1()
Dim Bereich As Range
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Endspalte = Selection.Columns(Selection.Columns.Count).Column
Endzeile = Selection.Rows(Selection.Rows.Count).Row
Startspalte = 1
Startzeile = 1
Set Bereich = Range(Cells(Startzeile, Startspalte), Cells(Endzeile, Endspalte))
Calculate
For Each Z In Bereich
On Error Resume Next
If Z.HasFormula Then
Select Case Left(Z.Formula, 4)
Case "=DBR"         ' DBRn - Funktion
Z.Value = Z.Value
Case "=DBS"         ' DBSn - Funktion
Z.Value = Z.Value
Case "=SUB"         ' SUBNM - Funktion
Z.Value = Z.Value
Case "=VIE"         ' VIEW - Funktion
Z.Value = Z.Value
Case "=DIM"         ' DIMNM - Funktion
Z.Value = Z.Value
End Select
End If
Next Z
Calculate
Mldg = "Alle TM1-Funktionen wertkopiert"
MsgBox (Mldg)
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro Wertkopie
24.05.2016 13:14:00
ChrisL
Hi Martin
Vielleicht so:
Sub Wertkopie_DBR_DBS_TM1()
Dim WS As Worksheet
If MsgBox("Alle Blätter?", vbQuestion + vbYesNo, "Rückfrage") = vbYes Then
For Each WS In ThisWorkbook.Worksheets
Call frmlUmwandeln(WS)
Next WS
Else
Call frmlUmwandeln(ActiveSheet)
End If
MsgBox "Alle TM1-Funktionen wertkopiert"
End Sub

Private Sub frmlUmwandeln(WS As Worksheet)
Dim Bereich As Range, Z As Range
On Error Resume Next
Set Bereich = WS.UsedRange
For Each Z In Bereich
If Z.HasFormula Then
Select Case Left(Z.Formula, 4)
Case "=DBR", "=DBS", "=SUB", "=VIE", "=DIM"
Z.Value = Z.Value
End Select
End If
Next Z
End Sub

cu
Chris

Anzeige
AW: Makro Wertkopie
24.05.2016 13:33:21
UweD
Hallo
SpecialCells(xlCellTypeFormulas) dadurch werden nur die Zellen mit Formeln abgearbeitet...

Sub Wertkopie_DBR_DBS_TM1()
Dim Z, Bl
Dim Alle
Calculate
Alle = MsgBox("Alle Blätter?", vbYesNo, "TM1 -Wertkopie")
If Alle = vbYes Then
For Each Bl In Sheets
Call DBR(Bl)
Next
Else
Set Bl = ActiveSheet
Call DBR(Bl)
End If
Calculate
MsgBox ("Alle TM1-Funktionen wertkopiert")
End Sub
Private Sub DBR(Bl)
Dim Z
On Error Resume Next
For Each Z In Bl.Cells.SpecialCells(xlCellTypeFormulas)
Select Case Left(Z.Formula, 4)
Case "=DBR", "=DBS", "=SUB", "=VIE", "=DIM"
Z.Value = Z.Value
End Select
Next Z
End Sub

Gruß UweD

Anzeige
AW: Makro Wertkopie
24.05.2016 17:58:35
ChrisL
Hi Uwe
Beitrag gelesen und SpecialCells(xlCellTypeFormulas) merke ich mir, oder ich versuche es zu mindest ;)
cu
Chris

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige