Sub QF_analysieren()
'
' QF_analysieren Makro
'
' Tastenkombination: Strg+Umschalt+Q

' Daten aus AdWords Editor auf Keyword Basis kopieren, dann Makro starten


' behebt Datumsproblem beim Einfügen
' erstellt eine Pivottabelle
' wartet zwischen den Schritten (iTimeToWait)


' definiert Verzögerung zwischen den Schritten
Dim iTimeToWait As Integer
iTimeToWait = 2000



Dim sTableName As String
sTableName = "Tabelle1"

Dim sTableNameTmpPivot As String
sTableNameTmpPivot = "tmpPivot"

Dim lLastRow As Integer
Dim iLastColumn As Integer


    Cells.Select
    
    Selection.NumberFormat = "@"
    
    Range("A1").Select
    
    ActiveSheet.Paste
    
    Wait (iTimeToWait)
    
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A1").Select
    Selection.Copy
    
    Range(Selection, Selection.SpecialCells(xlLastCell)).Select
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
        SkipBlanks:=False, Transpose:=False
    
    Wait (iTimeToWait)
    
    Range(Selection, Selection.SpecialCells(xlLastCell)).Select
    Selection.NumberFormat = "0.00"
    
    Wait (iTimeToWait)
    
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Campaign"
    
    ' Range(Selection, Selection.SpecialCells(xlLastCell)).Select
 

Wait (iTimeToWait)

lLastRow = Sheets(sTableName).UsedRange.SpecialCells(xlCellTypeLastCell).Row
iLastColumn = Cells(2, Columns.Count).End(xlToLeft).Column

sRangeForPivotTable = sTableName & "!R1C1:R" & CStr(lLastRow) & "C" & iLastColumn

Wait (iTimeToWait)

Sheets.Add.Name = sTableNameTmpPivot
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        sRangeForPivotTable). _
        CreatePivotTable TableDestination:=sTableNameTmpPivot & "!R3C1", TableName:= _
        "PivotTable1"
    Sheets(sTableNameTmpPivot).Select

Wait (iTimeToWait)

    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Quality Score")
        .Orientation = xlRowField
        .Position = 1
    End With

    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Cost"), "Summe von Cost", xlSum
 
    Wait (iTimeToWait)
 
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/R8C2"
    Range("C4").Select
    Selection.Copy
	
	' muss angepaßt werden
    Range("C5:C7").Select
    ActiveSheet.Paste
    
    Wait (iTimeToWait)
    
    Range("C4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormatConditions.AddDatabar
    Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = True
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1)
        .MinPoint.Modify newtype:=xlConditionValueLowestValue
        .MaxPoint.Modify newtype:=xlConditionValueHighestValue
    End With
    
    Wait (iTimeToWait)
    
    With Selection.FormatConditions(1).BarColor
        .Color = 13012579
        .TintAndShade = 0
    End With
    Application.CutCopyMode = False
    Selection.Style = "Percent"
    Selection.NumberFormat = "0.0%"
    Selection.NumberFormat = "0.00%"
    Range("C3").Select
 
    Wait (iTimeToWait)
    
    MsgBox ("Fertig")
    
End Sub


Public Function Wait(MilliSekunden As Double)
Dim I As Double, Ende As Double
Ende = Timer + (MilliSekunden / 1000)
Do While I < Ende
  DoEvents
  I = Timer
Loop
End Function