لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
هانى على لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة طلب استخراج بيانات متخصصة لصفحة مستقلة اكسل وpdfمن جدول فعاليات اكسيل اسئله واجابات



مرحبا بك في منتديات أكاديمية الصقر للتدريب.
أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .







  • غير مجابة
15-05-2022 04:01 مساءً
معلومات الكاتب ▼
تاريخ الإنضمام : 07-12-2019
رقم العضوية : 16447
المشاركات : 13
الجنس :
تاريخ الميلاد : 8-6-1976
قوة السمعة : 22
الاعجاب : 0
السلام عليكم ورحمه الله وبركاته
ممكن المساعده فى عمل كود لنسخ ملفات PDF و اكسيل من مجلد إلى مجلد آخر بالاعتماد على قائمة فى ملف اكسيل ( العمود A ) مع مراعاه أن وجد ملفات متشابها يتم نسخ المتشابه أيضاً




look/images/icons/i1.gif نسخ ملفات pdf و Excel من مجلد إلى مجلد بالاعتماد على قائمة فى ملف اكسيل
  02-04-2023 05:54 صباحاً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 15-02-2018
رقم العضوية : 4397
المشاركات : 449
الجنس :
تاريخ الميلاد : 29-12-1985
قوة السمعة : 1085
الاعجاب : 0
وعليكم السلام
على حسب ما فهمت من حضرتك
CODE
Sub CopyFilesBasedOnList()
    
    'تحديد المجلد الذي يحتوي على الملفات المراد نسخها
    Dim sourceFolder As String
    sourceFolder = "C:FolderName"
    
    'تحديد المجلد الذي يحتوي على الملفات المراد لصقها
    Dim destFolder As String
    destFolder = "C:NewFolderName"
    
    'تحديد اسم ملف الاكسل ورقم الورقة المستخدمة
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = Workbooks("ExcelFileName.xlsx")
    Set ws = wb.Worksheets("Sheet1")
    
    'تحديد المدى الذي يحتوي على الأسماء في العمود A
    Dim lastRow As Long
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    Dim nameRange As Range
    Set nameRange = ws.Range("A2:A" & lastRow)
    
    'تحديد كل الملفات في المجلد المحدد
    Dim file As Variant
    Dim files As Collection
    Set files = New Collection
    Dim fileName As String
    fileName = Dir(sourceFolder & "*")
    While fileName <> ""
        files.Add fileName
        fileName = Dir()
    Wend
    
    'تنفيذ النسخ
    Dim cell As Range
    Dim fileExists As Boolean
    For Each cell In nameRange
        fileExists = False
        For Each file In files
            If InStr(1, file, cell.Value, vbTextCompare) > 0 Then
                If fileExists = False Then
                    'نسخ الملف إلى المجلد المحدد
                    FileCopy sourceFolder & file, destFolder & file
                    fileExists = True
                Else
                    'إذا وجد ملفات متشابهة، يتم نسخها أيضا
                    FileCopy sourceFolder & file, destFolder & "(1)" & file
                End If
            End If
        Next file
    Next cell
    
    MsgBox "تمت العملية بنجاح"
    
End Sub

-------------------------
ملحوظه: يقوم الكود بنسخ جميع الملفات الموجودة في المجلد المحدد (sourceFolder) والتي تم تحديدها في قائمة في ملف Excel في العمود A إلى المجلد الجديد (destFolder). كما يتم مراعاة نسخ الملفات المتشابهة. 
يجب عليك تغيير قيم المتغيرات (sourceFolder و destFolder و ExcelFileName و Sheet1) لتتناسب مع احتياجاتك.




اضافة رد جديد اضافة موضوع جديد



المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
ايقاف فيرس Ransomware واستعاداة الملفات Yasser Elaraby
6 2274 star
اريد كود لطباعه جميع ملفات البى دى اف مره واحده EM_ACC
2 76 EM_ACC
تجميع بيانات من عدة ملفات بليغ البتول
1 53 بليغ البتول
أكبر تجميعية لملفات PSD مفتوحة المصدر جاهزة للتعديل إهداء لأعضاء وزوار المنتدي الكرام عوض السوداني
0 51 عوض السوداني
07 _ دمج المراسلات باستخدام البايثون (إنشاء العديد من ملفات الورد) YasserKhalil
7 588 YasserKhalil

الكلمات الدلالية
ملفات ، Excel ، مجلد ، مجلد ، بالاعتماد ، قائمة ، اكسيل ،








اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 05:16 PM.