Önceki mesajdajdaki dosyayı eklemeyi unutmuşum abey.

---

(22/04/2021, 21:49)yyhy yazdı: Birim (01).....Birim (50) sayfalardan veriyi alırken B2:Q aralığını aldırmam için macro kodunda ne gibi değişiklik yapabiliriz?

Private Sub CommandButton1_Click()

    Dim rs As Object, con As Object

    Dim son As Long

    

    Set rs = CreateObject("ADODB.Recordset")

    Set con = CreateObject("ADODB.Connection")

    Dim yol As String, yol2 As String

    

    yol = ThisWorkbook.Path & Application.PathSeparator

    yol2 = Dir(yol & "*xlsx")



    With ThisWorkbook.Sheets("TümVeri")

        

        .Range("A2:Q" & Rows.Count).Clear

        Do Until yol2 = ""

                son = .Range("B" & Rows.Count).End(3).Row + 1

                con.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & yol2 & ";extended properties=""Excel 12.0;hdr=yes"""

                rs.Open "select * from [MEMURLAR$B1:Q]", con, 1, 1

                

                .Range("B" & son).CopyFromRecordset rs

                rs.Close

                con.Close

            yol2 = Dir

        Loop

    End With

    Set rs = Nothing

    Set con = Nothing

    MsgBox "Bitti", vbInformation, "Bilgi"

End Sub