Soru Kaydet Makrosu Alt Alta Kaydetmiyor

[aras90]

Merhaba arkadaşlar. Bir siteden veri çekip bu veriyi oluşturduğum kaydet sayfasında arşivliyorum.

Sorunum veriler çekiliyor ancak hepsi A2 hücresine üst üste yazılıyor benim isteğim A2 hücresinden başlayarak alt alta listelemesi. Excel 2013 kullanıcısıyım.

Kaydet makrosu kodların en alt kısmında

Yardımlarınızı bekliyorum. İyi çalışmalar

Sub Analiz()

'
' Veri
'
    'Sheets("TeamData").Visible = xlSheetVisible
    Sheets("TeamData").Select
    'ActiveSheet.Unprotect "NOWPRO2018"
    macadress = Sheets("OddsData").Range("AF4").Value
    Columns("A:T").Select
    Selection.ClearContents
    Range("A1").Select
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;" & macadress, _
            Destination:=Range("$A$1"))
            .Name = "1418066"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = False
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "1,3,4,5,13,""table_v1"",""table_v2"""
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = True
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
   
     'ActiveSheet.Protect "NOWPRO2018"
    'Sheets("TeamData").Visible = xlSheetVeryHidden
    Sheets("Statistic").Select
    Range("F1").Select
    Range("B2:K2").Select
    Sheets("TeamData").Select
    Range("AD:AF,AO:AQ").Select
    Range("AO1").Activate
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("C33").Select
    ActiveWindow.SmallScroll Down:=6
    Range("C33:C93").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("C33:C93,G33:G93").Select
    Range("G33").Activate
    ActiveWindow.SmallScroll Down:=-27
    Selection.Replace What:="(N)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(RS)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(MG)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(SP)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="1", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="2", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="3", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("C20").Select
    Sheets("KAYDET").Select
    Range("D2").Select
   



    Dim LR  As Long, i  As Long, cls
cls = Array("K32", "L32", "M32", "N32", "O32", "P32", "Q32", "R32", "S32", "T32", "U32", "V32", "W32", "X32", "Y32", "Z32", "AA32", "AB32", "AC32", "AD32", "AE32", "AF32", "AG32", "AH32", "AI32", "AJ32", "AK32", "AL32", "AM32", "AN32", "AO32", "AP32", "AQ32", "AR32", "AS32", "AT32")
With Sheets("KAYDET")
    LR = WorksheetFunction.Max(2, .Range("A" & Rows.Count).End(xlUp).Row + 1)
    For i = LBound(cls) To UBound(cls)
        .Cells(LR, i + 1).Value = Sheets("Statistic").Range(cls(i)).Value
    Next i
    Sheets("KAYDET").Select
    Range("A2").Select
End With



End Sub

 

[Necdet]

Merhaba,

Destination:=Range("$A$1"))

Burada A1 hücresine yazılıyor.
son hücreyi bulup o adresi verin.

 

[aras90]

Merhaba,

Destination:=Range("$A$1"))

Burada A1 hücresine yazılıyor.
son hücreyi bulup o adresi verin.

Teşekkür ederim ancak biraz daha açıklar mısınız hocam ne şekilde düzenlemem gerektiğini anlayamadım

 

[aras90]

Yardımcı olabilecek yok mu arkadaşlar?

 

[aras90]

Çözüldü..Konu Kilitlenebilir.

 

[Necdet]

Çözüldü..Konu Kilitlenebilir.

Merhaba,
Nasıl çözüldüğünü açıklarsanız aynı sorunu yaşayan ya da karşılaşacak olan arkadaşlarımıza yardımcı olur.

 

[aras90]

Merhaba,
Nasıl çözüldüğünü açıklarsanız aynı sorunu yaşayan ya da karşılaşacak olan arkadaşlarımıza yardımcı olur.

Makroda bir sorun yok aslında sadece yedek dosyamda bir sorun olmadığını fark ettim çalışmamı oraya aktardım problemin tam olarak neden kaynaklandığını bilmiyorum.