Formel anpassen

Sub Makro5() Dim WkSh_Z As Worksheet ' das Empfangs-Workbook - das Ziel Dim WkSh_Q As Worksheet Dim lZeile_Q As Long Dim iSpalte_Q As Integer Dim iSpalte_Z As Integer Dim aZeilen As Variant Dim iIndex As Integer Set WkSh_Z = Worksheets("3_Verkäuferranking") Set WkSh_Q = Worksheets("12_Eingabevorlage") iSpalte_Q = ActiveCell.Column 'die folgende Zeile funktioniert, es wird die Formel hinterlegt: ' Range("B7").FormulaR1C1 = "=+'12_Eingabevorlage'!R[-3]C[6]" 'wollte jetzt automatisch die Formel der Spalte anpassen, klappt nicht: ' Range("B7").FormulaR1C1 = "=+'12_Eingabevorlage'! Cells(7, iSpalte_Z)" 'geht auch nicht Range("B7").FormulaR1C1 = "=+'WkSh_Z'!.Cells(7, iSpalte_Z)" End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Test_Ranking() Dim WkSh_Z As Worksheet ' das Empfangs-Workbook - das Ziel Dim WkSh_Q As Worksheet ' zur bequemeren Schreibweise Dim lZeile_Q As Long Dim iSpalte_Q As Integer Dim iSpalte_Z As Integer Dim aZeilen As Variant Dim iIndex As Integer Set WkSh_Z = Worksheets("3_Verkäuferranking") Set WkSh_Q = Worksheets("12_Eingabevorlage") aZeilen = Array(4, 6, 7, 10, 11, 12, 16, 34, 35, 18, 19, 25, 26, 27, 29, 30, 31, _ 32) iSpalte_Q = ActiveCell.Column iSpalte_Z = 2 With WkSh_Q For iIndex = 0 To UBound(aZeilen) .Cells(aZeilen(iIndex), iSpalte_Q).Copy WkSh_Z.Cells(7, iSpalte_Z).PasteSpecial Paste:=xlFormulas ' Formeln WkSh_Z.Cells(7, iSpalte_Z).PasteSpecial Paste:=xlValues ' Werte iSpalte_Z = iSpalte_Z + 1 Next iIndex End With Range("B7").Select End Sub

Hallo Zusammen,
so ich habe eine Lösung erhalten und das Funktioniert.
Es werden zwar nicht die Formel kopiert, jedoch werden die kompl. Daten NEU
in die Ranking-Tabelle kopiert.
Hier das Makro:


Sub Test_Ranking_Alle()
Dim WkSh_Z     As Worksheet      ' das Empfangs-Workbook - das Ziel
Dim WkSh_Q     As Worksheet      ' zur bequemeren Schreibweise
Dim rZelle     As Range
Dim iStrt_Sp   As Integer
Dim iEnde_Sp   As Integer
Dim lZeile_Q   As Long
Dim lZeile_Z   As Long
Dim iSpalte_Q  As Integer
Dim iSpalte_Z  As Integer
Dim aZeilen    As Variant
Dim iIndex     As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set WkSh_Z = Worksheets("3_Verkäuferranking")
Set WkSh_Q = Worksheets("12_Eingabevorlage")
aZeilen = Array(4, 6, 7, 10, 11, 12, 16, 34, 35, 18, 19, 25, 26, 27, 29, 30, 31, _
32)
With WkSh_Q.Rows(4)
Set rZelle = .Find("zzA", LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
iStrt_Sp = rZelle.Column + 1
Else
MsgBox "Der Suchbegriff  ""zzA"" konnte nicht gefunden werden - Abbruch", _
48, "   Hinweis für " & Application.UserName
Exit Sub
End If
Set rZelle = .Find("zzE", LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
iEnde_Sp = rZelle.Column - 1
Else
MsgBox "Der Suchbegriff  ""zzE"" konnte nicht gefunden werden - Abbruch", _
48, "   Hinweis für " & Application.UserName
Exit Sub
End If
End With
lZeile_Z = 6  ' die Start-zeile - 1 im Ziel-Blatt
With WkSh_Q
For iSpalte_Q = iStrt_Sp To iEnde_Sp ' alle Verkäufer zwischen zzA und zzE
iSpalte_Z = 2                     ' die Start-Spalte im Ziel-Blatt
lZeile_Z = lZeile_Z + 1           ' die nächste Ausgabezeile errechnen
For iIndex = 0 To UBound(aZeilen) ' alle Zeilen im Array aZeilen
.Cells(aZeilen(iIndex), iSpalte_Q).Copy
WkSh_Z.Cells(lZeile_Z, iSpalte_Z).PasteSpecial Paste:=xlFormulas ' Formeln
WkSh_Z.Cells(lZeile_Z, iSpalte_Z).PasteSpecial Paste:=xlValues   ' Werte
iSpalte_Z = iSpalte_Z + 1
Next iIndex
Next iSpalte_Q
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

mfg Walter MB

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread