CODE
Sub Consolidate_All_Sheets_In_One_Using_Arrays()
Dim ws As Worksheet
Dim temp As Variant
Dim arr As Variant
Dim f As Boolean
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Total" Then
temp = ws.Range("A4:o" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value2
If f Then
arr = ArrayJoin(arr, temp)
Else
arr = temp
f = True
End If
End If
Next ws
With Sheets("Total")
.Range("a4:o65536").ClearContents
'.Range("A1").Resize(1, 3).Value = Array("م", "الاسم", "الرقم الوظيفي")
.Range("A4").Resize(UBound(arr, 1), UBound(arr, 2)).Value2 = arr
End With
End Sub
Function ArrayJoin(ByVal a, ByVal b)
Dim i As Long
Dim ii As Long
Dim ub As Long
ub = UBound(a, 1)
a = Application.Transpose(a)
ReDim Preserve a(1 To UBound(a, 1), 1 To ub + UBound(b, 1))
a = Application.Transpose(a)
For i = LBound(b, 1) To UBound(b, 1)
For ii = 1 To UBound(b, 2)
a(ub + i, ii) = b(i, ii)
Next ii
Next i
ArrayJoin = a
End Function
اريد نسخ هذا الكود
الموجود فى موديل واحد
اضافه كود في حدث الشيت