كيفي انفذ ماكرو على جميع أوراق العمل

[الميزار]

السلام عليكم ورحمة الله وبركاته 

 

أخواني الكران أرجوا أن تتحملوني في هذا المنتدى الشامج برجالاته ، فأخوكم مبتدء في الاكواد في الأكسل ولاول مرة استخدمها 

 

يوجد لدي ملف اكسل به أكثر من 100 ورقة عمل في بعض الاحيان وأريد أن احذف بعض الأعمدة والصفوف فبعد جهد وتعلم من كتابات أستاتيذي الكرام قمت بإنشاء هذا الكود 

Sub SS()
Application.ScreenUpdating = False
Range("A1:A7,A9:A11,A13:A19").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
 Range("A1").Select
 Application.ScreenUpdating = True
Application.ScreenUpdating = False
Range("A1:B1").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireColumn.Delete
 Range("A1").Select
 Application.ScreenUpdating = True

Application.ScreenUpdating = False
For I = B To Z
If I = Null Then
Cells(I, 3).Value = ""
End If
Next I
Range("B3:Z3").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireColumn.Delete
 Range("B3").Select
 Application.ScreenUpdating = True
End Sub

 ولا أدري هل هو صحيح في الاصل أو لا ولكن عند تطبيقه قام بالعمل المراد ببالصورة المطلوبة 

 

ولكن المشكلة أني أقوم بفتح كل ورقة عمل وتطبيق الماكرو عليها 

 

ما اريده عند تنفيذ هذا الماكرو يقوم بالنتفيذ على جيمع أوراق العمل 

 

والسلام ختام 

[أبوعيد]

السلام عليكم

جرب هذا

إذا فرضنا أن عندك 100 ورقة بالتمام 

Sub SS()
Application.ScreenUpdating = False
for i = 1 to 100
sheets(i).activate
Range("A1:A7,A9:A11,A13:A19").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
 Range("A1").Select
 Application.ScreenUpdating = True
Application.ScreenUpdating = False
Range("A1:B1").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireColumn.Delete
 Range("A1").Select
 Application.ScreenUpdating = True

Application.ScreenUpdating = False
For I = B To Z
If I = Null Then
Cells(I, 3).Value = ""
End If
Next I
Range("B3:Z3").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireColumn.Delete
 Range("B3").Select
next i
 Application.ScreenUpdating = True
End Sub

أضفت سطرين في الأعلى بعد هذا السطر

Application.ScreenUpdating = False

وهما (100 هي عدد الأوراق في الملف)

for i = 1 to 100

sheets(i).activate

 

وسطر واحد في الأسفل قبل هذا السطر

Application.ScreenUpdating =True

وهو

next i

[سليم حاصبيا]

اخي الميزار

ربما يعجبك هذا الكود

مسح صفوف.rar

[الميزار]

بارك الله في الجميع ولا حرمكم الله الاجر 

 

يعطيك العافية أخي العزيز أبوعيد 

 

 كانت المشكلة في الكود  أنه تم تحديد عدد أوراق العمل وهذا قد يعمل مشكلة لدي .

 

أخي الكريم سليم بارك الله فيك 

 

أما هنا كانت المشكلة حذف الصفوف فقط وكان في الكود حذف صفوف وأعمدة 

 

وعند جمع الكودين من الأخوين الكريم  خرجت بالكود التالي وهو قد حل المشلكة 

Sub ss()
Application.ScreenUpdating = False
x = Worksheets.Count
For g = 1 To x
Sheets(g).Activate
Range("A1:A7,A9:A11,A13:A19").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
Range("A1").Select
 
Range("A1:B1").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireColumn.Delete
 Range("A1").Select
For I = B To Z
If I = Null Then
Cells(I, 3).Value = ""
End If
Next I
Range("B3:Z3").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireColumn.Delete
 Range("B3").Select
     Next g
 Application.ScreenUpdating = True
End Sub

فإذا كان هناك من تعديل أو حل آخر 

مع العلم أن الكود قام بالمطلووووووووووووووب

والسلام ختام 

تم تعديل مايو 2, 2014 بواسطه الميزار