كود ترحيل بطريقة جديدة

[نثغةثمسخبف]

الرجاء المساعة بترحيل بيانات وخلايا مع طباعة التحديد

ربما يكون الموضوع مكرر لكنني لم اجد ضالتي بالرغم من البحث . وجدت ترحيل اعمدة . خلايا محددة

ولكن خلايا متفرقة مع عمود وطباعة بنفس الوقت لم اجده

ترحيل.rar

[moaaz2020]

اخي الكريم خبرتي ضعيفه لكن ساعطيك كود ترحيل من خلايا مختلفه وجدته في المنتدى

حاولت يمكن ان اكتب اسم الصفحه المراد الترحيل بها بدل من Sheets(1) وفشلت انمنى من اصحاب الخبره التعديل فيه

 

Dim EndRow As Long
For I = 2 To 2
EndRow = Sheets(I).Range("B1").CurrentRegion.Rows.Count
Sheets(I).Cells(EndRow + 1, 1).Value = Sheets(1).Cells(2, 5).Value
Sheets(I).Cells(EndRow + 1, 2).Value = Sheets(1).Cells(2, 3).Value
Sheets(I).Cells(EndRow + 1, 3).Value = Sheets(1).Cells(4, 3).Value
Sheets(I).Cells(EndRow + 1, 4).Value = Sheets(1).Cells(6, 3).Value
Sheets(I).Cells(EndRow + 1, 7).Value = Sheets(1).Cells(8, 3).Value
Sheets(I).Cells(EndRow + 1, 5).Value = Sheets(1).Cells(7, 8).Value
Sheets(I).Cells(EndRow + 1, 6).Value = Sheets(1).Cells(10, 2).Value

Next I

وهذا شيت الطباعه الذي استخدمه بعد ان احدد نطاق الطباعه مسبقا 

Sheets("الفاتوره").PrintOut Copies:=1, Collate:=True

Application.ScreenUpdating = False

اتمنى ان تستفيد منه

[نثغةثمسخبف]

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

Option Explicit
Sub TransferUsingArray()
    Dim Arr
    
    With Sheets("1")
        Arr = Array(.Range("I1"), .Range("I2"), .Range("I3"), .Range("E25"), .Range("E26"), .Range("C9"), .Range("E9"), .Range("G9"), .Range("J9"), .Range("C11"), .Range("E11"), .Range("G11"), .Range("J11"), .Range("C13"), .Range("E13"), .Range("G13"), .Range("J13"), .Range("C15"), .Range("E15"), .Range("G15"), .Range("J15"))
        
    End With
    
    With Sheets("2")
        .Range("A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Resize(1, UBound(Arr) + 1).Value = Arr
    End With
    
    MsgBox "Done...", 64
End Sub

ولكنني اريد ترحيل الاعمدة التي تحتوي على الطلبات بشكل اعمدة

[SHEREF ADEL]

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

Dim iRow As Long
Dim ws As Worksheet

Set ws = Worksheets("اسم الشيت اللى هترحل منه البيانات")
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(9, 2).Row

ws.Cells(iRow, 2).Value = Me.TextBox2.Value
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(10, 2).Row

ws.Cells(iRow, 2).Value = Me.TextBox3.Value
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(11, 2).Row

ws.Cells(iRow, 2).Value = Me.TextBox4.Value
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(12, 2).Row

ws.Cells(iRow, 2).Value = Me.TextBox5.Value
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(13, 2).Row

ws.Cells(iRow, 2).Value = Me.TextBox6.Value
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(14, 2).Row

ws.Cells(iRow, 2).Value = Me.TextBox7.Value
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(15, 2).Row

ws.Cells(iRow, 2).Value = Me.TextBox8.Value
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(16, 2).Row

ws.Cells(iRow, 2).Value = Me.TextBox9.Value
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(17, 2).Row

 Me.TextBox12.Value = ws.Cells(iRow, 2).Value
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(22, 7).Row
 
ws.Cells(iRow, 2).Value = Me.TextBox13.Value
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(23, 1).Row

هنا انا كنت بدخل على عمود  رقم اتنين بس بغير  رقم الصف ولما حبيت اغير المكان  قمت بتغيير رقم العمود  اتمنى ان يكون الحل مناسب لك

[نثغةثمسخبف]

الاخ شريف عادل

شكرا على تعبك معي ولك مني تحيات خاصة

هل يمكنك تطبيق الكود على ملفي لانني مازلت بالبدايات

[عبدالفتاح في بي اكسيل]

تفضل   لعل  هذا  ما  تبحث  عنه  لقد   تم  الغاء  خلايا  الدمج   وتسمية  الاوراق  بالانجليزي   حتى  يعمل  الكود 

ملاحظة  اخيرة   لا تضغط   الملف  مرة  اخرى   

posting.xlsm

[نثغةثمسخبف]

شكرا جزيلا والى جميع عمالقة المنتدى

لكن في حال الضغط على امر copy تم ملاحظة انه في حال الترحيل يقوم الامر بترحيل السطر صحيح لكنه يحجز سطر اخر يليه لخليتين هي التاريخ والقسم

[عبدالفتاح في بي اكسيل]

لم افهم عليك وضح اكثر 

[نثغةثمسخبف]

لاحظ اخي هناك ثلاثة اقلام فقط بصفحة الطلب

بينما الترحيل تصبح اربعة اقلام

نفس النتيجة مهما كان عدد الاقلام . فهناك حجز لسطر اخير

[عبدالفتاح في بي اكسيل]

تم معالجة  الامر 

posting.xlsm

[نثغةثمسخبف]

شكرا جزيلا . وجعله الله في ميزان حسناتك

بالفعل تم الامر

[أحمد يوسف]

نثغةثمسخبف

أين الضغط على الإعجاب لهذه الإجابة الممتازة ؟!!!💙