المساعد فى تعديل كود نسخ البيانات من ملفات مغلقة

لوحة التميز الأسبوعي
العضو المتميز	المشرف المتميز	المراقب المتميز	المدير المتميز	الموضوع المتميز	القسم المتميز

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

آخر المشاركات

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

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

: المساعد فى تعديل كود نسخ البيانات من ملفات مغلقة

06-12-2024 04:10 مساءً

Lotfy

عضو

تاريخ الإنضمام : 07-12-2019

رقم العضوية : 16447

المشاركات : 15

رصيد العضو : 10

الجنس :

تاريخ الميلاد : 8-6-1976

قوة السمعة : 22

الاعجاب : 0

من مواضيع :Lotfy

	المساعد فى تعديل كود نسخ ..
	كود نسخ البيانات من ملفات ..
	نسخ ملفات pdf و Excel من ..
	ترحيل بيانات من خلايا مخت ..
	ربط الاقساط بشيت المرتبات ..

السلام عليكم ورحمة الله وبركاته جمعة طيبة ان شاء الله
بعد اذن الاخوة الكرام كنت عاوز تعديل على الكود
التعديل رقم 1 : والكود وهو بيدخل ينسخ داخل الملفات وهى مغلقة ينسخ جميع الشيتات الموجودة داخل الملفات
التعديل رقم 2 : عاوز عند لصق البيانات تكون لصق values بدون تنسيقات او معادلات
التعديل رقم 3 : عاوز احدد داخل الكود عملية النسخ بتكون من العمود a الى العمود h
التعديل رقم 4 : عند لصق البيانات تكون تحت بعد وميكونش فى صف فاضى اذا كان فى صفوف فارغة لا يجلبها لى وياتى بالصفوف الممتلئه تحت بعض
Sub information()

Dim wb As Workbook, lr1 As Integer, lr2 As Integer
Dim fil As Variant, dat As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

lr1 = Sheets("Temp").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Temp").Range("A10:G" & lr1 + 1).ClearContents

INF = ThisWorkbook.Path
fil = Dir(INF & "\*.xl??")

Do While fil <> ""
If fil <> "DATA.xlsm" Then

Set wb = Workbooks.Open(INF & "" & fil)
lr1 = Workbooks("Data").Sheets("Temp").Cells(Rows.Count, 1).End(xlUp).Row
lr2 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("A2:F" & lr2).Copy Workbooks("DATA").Sheets("Temp").Range("A" & lr1 + 1)
dep = Left(ActiveWorkbook.Name, Application.Search(".", ActiveWorkbook.Name) - 1)
Workbooks("DATA").Sheets("Temp").Range("g" & lr1 + 1 & ":g" & lr1 + lr2 - 1) = dep
ActiveWorkbook.Close
End If
fil = Dir
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

أعجبني

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

المواضيع المتشابهه
عنوان الموضوع	الكاتب	الردود	الزوار	آخر رد
طلب المساعدة في ادراج كود لترحيل واستدعاء البيانات	foular	2	1719	YasserKhalil

الكلمات الدلالية

المساعد ، تعديل ، البيانات ، ملفات ، مغلقة ،

« طلب ملف لطباعة الشيكات في الاكسيل | لا يوجد»

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

سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 03:51 PM

سياسة الخصوصية