قمت بوضع سؤال وقام الاخ خابور بمساعدتي شاكراُ له سرعه التجاوب
لكن لم استطع فهم الكود اريد احد يشرح لي الكود بتفصيل ممل .
لانه عند قيامي بأضافة بعض البنود لم يعمل الكودمعي .
Private Sub Worksheet_Activate()
KH_START
End Sub
و
Sub KH_START()
Dim MyCell As Range
Set MyCell = Range("البيانات")
Dim X As Integer, C As Integer, CC As Integer
Dim R As Integer, RR As Integer
Application.ScreenUpdating = False
'==========================
' مسح البيانات المرحلة السابقةان وجدت
With ورقة2
X = .UsedRange.Rows.Count + 6
.Range("B7:K" & X).ClearContents
End With
'============================
' ترحيل البيانات الجديدة
RR = 7
With MyCell
For C = 1 To 3
CC = Choose(C, 3, 7, 11)
For R = 1 To .Rows.Count
If .Cells(R, CC) <> "" Then
ورقة2.Cells(RR, 2) = .Cells(R, CC - 2)
ورقة2.Cells(RR, 5) = .Cells(R, CC - 1)
ورقة2.Cells(RR, 8) = .Cells(R, CC)
RR = RR + 2
End If
Next R
Next C
End With
Application.ScreenUpdating = True
End Sub
وجدت في الكود الثاني كلمة البيانات ماهو القصود منها .
اليكم المرفق وتم اضافة بنود باللون الاحمر ولم يشملها الترحيل ......
زادكم الله من علمة
3333.rar