Sub GrafikKopyala()
    Dim ppApp As PowerPoint.Application
    Dim ppSlide As PowerPoint.Slide
    Dim SheetName As String      'name of sheet in Excel that contains the range or chart to copy
    Dim TestRange As Range
    Dim TestSheet As Worksheet
    Dim TestChart As ChartObject
    Dim PasteChart As Boolean   'If True then routine will  copy and paste a chart
    Dim PasteChartLink As Boolean 'If True then Routine will paste chart with Link; if = False then paste chart no link
    Dim ChartNumber As Long 'Chart Object Number
    Dim PasteRange As Boolean   '- If True then Routine will copy and Paste a range
    Dim RangePasteType As String    '- Paste as Picture linked or unlinked, "HTML" or "Picture". See routine below for exact values
    Dim RangeName As String '- Address or name of range to copy; "B3:G9" "MyRange"
    Dim AddSlidesToEnd As Boolean
    Dim Baslik()
    Dim TabloIsim()
    Dim Sehir() As String
    Dim DosyaIsim
    'Dim SehirSayisi As Integer
    Dim SlideNumber As Integer
    Dim SheetNo As Integer
    'Dim GecenAyTarih As Date
    'Dim AyNo As Integer
    'Dim Ay As String
    'SehirSayisi = 1
    'SlideNumber = 3
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = msoTrue 'ppt penceresini visible yapar aksi halde fileopen olmaz
    ppApp.Presentations.Open Filename:= _
        "file://Tcjumbo/cno-rapor/Rapor_168/2009/Sunum.ppt", ReadOnly:=msoFalse
    RangePasteType = "Picture (Enhanced Metafile)"
    RangeLink = False 'True
    PasteChart = True
    PasteChartLink = False 'True
    AddSlidesToEnd = True
    ppApp.Visible = True
   For SlideNumber = 2 To 16 'veri yapıştırılacak sayda sayısı.
  
  
        If SlideNumber = 2 Then SlideNumber = SlideNumber + 1 'eger bu sayfaya orjinal dosyadan birse yapıştırmıyorsak,diğer sayfaya geçmesi için.
        If SlideNumber = 3 Then Bolge = "30"  ' "30" diye gözüken isim excel dosyasında sheet  adıdır.
        If SlideNumber = 4 Then Bolge = "31a"
        If SlideNumber = 5 Then Bolge = "APN"
        If SlideNumber = 6 Then SlideNumber = SlideNumber + 1
        If SlideNumber = 7 Then SlideNumber = SlideNumber + 1
        If SlideNumber = 8 Then SlideNumber = SlideNumber + 1
        If SlideNumber = 9 Then Bolge = "MultislotUtil"
        If SlideNumber = 10 Then Bolge = "PS Accessibility"
        If SlideNumber = 11 Then Bolge = "llc_int"
        If SlideNumber = 12 Then Bolge = "pdch usage"
        If SlideNumber = 13 Then Bolge = "latency"
        If SlideNumber = 14 Then Bolge = "Access"
        If SlideNumber = 15 Then Bolge = "Retain"
        If SlideNumber = 16 Then SlideNumber = SlideNumber + 1
   
                   
        k = 0
            If k = 0 Then DosyaAdi = "excel_dosya"
            Workbooks(DosyaAdi).Activate
            Sheets(Bolge).Select
            Range("A1").Select
            ppApp.ActiveWindow.View.GotoSlide SlideNumber
            Set ppSlide = ppApp.ActiveWindow.View.Slide
            Worksheets(Bolge).Range("A1:m27").Copy
            ppSlide.Shapes.PasteSpecial ppPasteEnhancedMetafile
            ppSlide.Shapes(ppSlide.Shapes.Count).Select  'hangi boyutlarda veri yapıştırmak istiyorsanız, on
            ppSlide.Shapes(ppSlide.Shapes.Count).Width = 700
            ppSlide.Shapes(ppSlide.Shapes.Count).Top = 90
            ppSlide.Shapes(ppSlide.Shapes.Count).Left = 10
        Next
    
                 
    
    Application.DisplayAlerts = False
    AppActivate ("Microsoft PowerPoint")
    ppApp.ActivePresentation.SaveAs "Sunum2.ppt"
    ppApp.Quit
    Application.DisplayAlerts = True
    Set ppSlide = Nothing
    Set ppApp = Nothing
End Sub