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

تعديل كود ترحيل


الردود الموصى بها

هذا كود ترحيل قام بإنجازه أستاذ qhq لي

Sub qhq()

Application.ScreenUpdating = False

 answ = MsgBox("åá ÊÑíÏ ÊÑÍíá ÇáÈíÇäÇÊ ÇáÊÇáíÉ", vbYesNo, " ÑÓÇáÉ ÊÃßíÏ ")

If answ = 6 Then

sheet2.Visible = xlSheetVisible

zz = Application.WorksheetFunction.CountA([c15:c24]) - 1

xx = sheet2.Cells(Rows.Count, sheet2.[a1:a11000].Column).End(xlUp).Row + 1

yy = Sheet1.Cells(Rows.Count, Sheet1.[f6:f11000].Column).End(xlUp).Row + 1

'---------------------------------------------------------------------------

sheet2.Range(sheet2.Cells(xx, "b"), sheet2.Cells(xx + 9, "c")) = Sheet4.[c15:d24].Value

sheet2.Range(sheet2.Cells(xx, "d"), sheet2.Cells(xx + 9, "i")) = Sheet4.[f15:k24].Value

sheet2.Range(sheet2.Cells(xx, "k"), sheet2.Cells(xx + 9, "k")) = Sheet4.[m15:m24].Value

sheet2.Range(sheet2.Cells(xx, "a"), sheet2.Cells(xx + zz, "a")) = Sheet4.[l7].Value

sheet2.Range(sheet2.Cells(xx, "j"), sheet2.Cells(xx + zz, "j")) = Sheet4.[l10].Value

sheet2.Range(sheet2.Cells(xx, "l"), sheet2.Cells(xx + zz, "l")) = Sheet4.[d8].Value

sheet2.Range(sheet2.Cells(xx, "m"), sheet2.Cells(xx + zz, "m")) = Sheet4.[d11].Value

sheet2.Range(sheet2.Cells(xx, "n"), sheet2.Cells(xx + zz, "n")) = Sheet4.[l9].Value

sheet2.Range(sheet2.Cells(xx, "o"), sheet2.Cells(xx + zz, "o")) = Sheet4.[d25].Value

'---------------------------------------------------------------------------

Sheet1.Range(Sheet1.Cells(yy, "g"), Sheet1.Cells(yy + 9, "h")) = Sheet4.[c15:d24].Value

Sheet1.Range(Sheet1.Cells(yy, "i"), Sheet1.Cells(yy + 9, "n")) = Sheet4.[f15:k24].Value

Sheet1.Range(Sheet1.Cells(yy, "p"), Sheet1.Cells(yy + 9, "p")) = Sheet4.[m15:m24].Value

Sheet1.Range(Sheet1.Cells(yy, "f"), Sheet1.Cells(yy + zz, "f")) = Sheet4.[l7].Value

Sheet1.Range(Sheet1.Cells(yy, "o"), Sheet1.Cells(yy + zz, "o")) = Sheet4.[l10].Value

Sheet1.Range(Sheet1.Cells(yy, "q"), Sheet1.Cells(yy + zz, "q")) = Sheet4.[d8].Value

Sheet1.Range(Sheet1.Cells(yy, "r"), Sheet1.Cells(yy + zz, "r")) = Sheet4.[d11].Value

Sheet1.Range(Sheet1.Cells(yy, "s"), Sheet1.Cells(yy + zz, "s")) = Sheet4.[l9].Value

Sheet1.Range(Sheet1.Cells(yy, "t"), Sheet1.Cells(yy + zz, "t")) = Sheet4.[d25].Value

'---------------------------------------------------------------------------

[l7] = (Left([l7], 5) + 1) & "R"

Range("c15:m24,l9:m9,d8:f8,d11:e11,d25:m27").ClearContents

MsgBox "Êã ÚãáíÉ ÇáÊÑÍíá ÈäÌÇÍ", vbMsgBoxRight, "ÑÓÇáÉ ÊÃßíÏ"

sheet2.Visible = xlSheetHidden

Else

MsgBox "áÞÏ Êã ÅáÛÇÁ ÚãáíÉ ÇáÊÑÍíá", vbMsgBoxRight, "ÑÓÇáÉ ÊÃßíÏ"

End If

End Sub

المطلوب : معرفة كيف يمكن جعل هذا الكود يتجاهل الخلايا غير المحتوية على اى بيانات فى الملف الهدف sheet4 وعدم ترحيلها أو بالأدق (تجاهلها) إلى الشيت المستهدف sheet1 أو sheet 2

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information