Sub Aktar()
    Dim Sql As String
    Dim ADO_CN As Object
    Dim ADO_RS As Object
    t = TimeValue(Now)
    ThisWorkbook.Sheets("Sayfa1").Range("A2:A" & Rows.Count).ClearContents
    
    Set ADO_CN = CreateObject("Adodb.Connection")
    Set ADO_RS = CreateObject("adodb.recordset")
'    Sql = "SELECT [Baslik 1] FROM [Sayfa2$A1:A] where [Baslik 1]>0"
    Sql = "SELECT [Baslik 1] FROM [Sayfa2$] where [Baslik 1]>0"
    ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _
    ";extended properties=""excel 8.0;hdr=yes;imex=1"""
    
    ADO_CN.Open
    ADO_RS.Open SQL, ADO_CN, 1, 1
    
    ThisWorkbook.Sheets("Sayfa1").Range("a2").CopyFromRecordset ADO_RS
    
    ADO_RS.Close
    ADO_CN.Close
    Set ADO_RS = Nothing
    Set ADO_CN = Nothing
    MsgBox CDate(TimeValue(Now) - t), vbInformation
End Sub

Sub Aktar2() 'dizi
    Dim arr(), i As Long, dizi(), say As Long
     t = TimeValue(Now)

    ReDim arr(1 To 100000, 1 To 1)
    ThisWorkbook.Sheets("Sayfa1").Range("B2:B100000").Value = ""
    dizi = ThisWorkbook.Sheets("Sayfa2").Range("A2:A100000").Value
    For i = LBound(dizi) To UBound(dizi)
        If dizi(i, 1) > 0 Then
            say = say + 1
            arr(say, 1) = i
        End If
    Next
    ThisWorkbook.Sheets("Sayfa1").Range("B2:B100000").Value = arr
    MsgBox CDate(TimeValue(Now) - t), vbInformation
    Erase dizi: Erase arr
End Sub