اذهب الي المحتوي
أوفيسنا

Rachid-VBA

عضو جديد 01
  • Posts

    3
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

1 Neutral

عن العضو Rachid-VBA

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    إدارة
  • البلد
    الجزائر
  • الإهتمامات
    EXCEL

اخر الزوار

بلوك اخر الزوار معطل ولن يظهر للاعضاء

  1. عذرًا على الإطالة .....تفضلوا البرنامج مع ملفات التجربة ..عذار ... تفضل جلب النتائج.xlsmتحليل النتائج الفصل الأول 2018-2019 رابعة متوسط 01.xls
  2. بسم الله الرحمان الرحيم السلام عليكم أعضاء منتدى اوفيسنا بدون اطالة .. المطلوب كالاتي لدي ملفات نفس الامتداد و الفورم محتوى الملف من الداخل قمت بانشاء ملف XLSM جاهز لجلب النتائج من العمود (الرقم) الى غاية العمود معدل (الفصل1) بعد عملية الجلبفي sheet1 النتيجة كالآتي: وفي نفس الوقت يقوم بنسخ عنوان الجدول في الخلية A5 في الصورة الاولى ولصقها في sheet2 في الخلية A1 اما في الخلية C2 بانشاء معدالة تقوم باختصار العنوان الرئيسي الى رمز للقسم الذي تم جلب نتائج تلاميذه وهذه المعادلة بعدها يقوم بنسخ الرمز ولصقه في الورقة sheet1 وهنا المشكلة....... عند عملية اللصق ... يقوم بلصقها عند اول خلية مع اول تلميذ ... نفس العملية عند جلب نتائج القسم الثاني ... المطلوب اريدتكرار لصق رمزالقسم عدة مرات مع نهاية صف كل قسم مثل ماهو في الصورة وهذا هو الكود الذي يقوم بالعملية Sub Import_4M() Dim filetoopen As Variant Dim openbook As Workbook Dim lastrow As Long Dim lastrow1 As Long Application.ScreenUpdating = False Application.DisplayAlerts = False filetoopen = Application.GetOpenFilename(Title:="Browse your file", filefilter:="Excel files (*.xls),*.xls") If filetoopen <> False Then Set openbook = Application.Workbooks.Open(filetoopen) lastrow1 = openbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row - 1 openbook.Sheets(1).Range("A7:T" & lastrow1).Copy lastrow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 5).End(xlUp).Row + 1 ThisWorkbook.Worksheets("Sheet1").Range("B" & lastrow).PasteSpecial xlPasteValues openbook.Sheets(1).Range("A5").Copy ThisWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial xlPasteValues ThisWorkbook.Worksheets("Sheet2").Range("C1").Copy ThisWorkbook.Worksheets("Sheet1").Range("A" & lastrow).PasteSpecial xlPasteValues openbook.Close False End If Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
×
×
  • اضف...

Important Information