وعليكم السلام
من عيوب الاكسل البطئ عندما تكون البيانات كبيرة .. ومن الطرق المفيدة في هذه الحالة هي استخدام لغة سيكول
اليك الكود الاتي ليقوم بالترحيل بسرعة اكبر من المعادلات .. المثال في المرفق
ملاحظة .. تمت التجربة علي اوفس 2013 وقد يحتاج الي تعديل مع النسخ الاخري
Sub InQuery()
Dim intLastR As Double
Dim strSQL
Dim Conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim srtPath As String, strConn As String
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
intLastR = ActiveSheet.UsedRange.Rows.Count
Sheets("Sheet2").Columns(1).ClearContents
srtPath = ThisWorkbook.FullName
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & srtPath & ";" & _
"Extended Properties=""Excel 12.0 Macro;HDR=Yes;IMEX=1"";"
intLastR = Sheets("Sheet1").UsedRange.Rows.Count
Conn.Open strConn
strSQL = "SELECT * From [Sheet1$A1:b" & intLastR & "] WHERE [Column1] = 1"
Debug.Print strSQL
Debug.Print Conn
rs.Open strSQL, Conn
Sheet2.Range("A2").CopyFromRecordset rs
Sheet2.Columns(2).ClearContents
rs.Close
Conn.Close
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
ارقام.rar
عبدالسلام ابوالعوافي's post in تناسب الكود مع تغيير اسم الشيت was marked as the answer