اختصار كود ترحيل البيانات من الفاتورة الى صفحة أخرى

[هانى محمد]

السلام عليكم احبائى واساتذتى الأعزاء,أتمنى ان تكونوا جميعا في أحسن حال

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

Private Sub FillSalesList()
      With Sheets("Sales").Columns(1).Rows(65536).End(xlUp)
            .Offset(1, 0) = Sheet1.[C1]
            .Offset(1, 1) = Sheet1.[C3]
            .Offset(1, 2) = Sheet1.[C5]
            .Offset(1, 3) = Sheet1.[C7]
            .Offset(1, 4) = Sheet1.[C9]
             .Offset(1, 5) = Sheet1.[A12]
             .Offset(1, 6) = Sheet1.[B12]
             .Offset(1, 7) = Sheet1.[C12]
             .Offset(1, 8) = Sheet1.[D12]
             .Offset(1, 9) = Sheet1.[E35]
         .Offset(1, 10) = Sheet1.[E36]
            .Offset(1, 11) = Sheet1.[E37]
            .Offset(1, 12) = Sheet1.[E38]
            If Sheet1.[a13].Value <> "" Then
             .Offset(2, 0) = Sheet1.[C1]
            .Offset(2, 1) = Sheet1.[C3]
            .Offset(2, 2) = Sheet1.[C5]
            .Offset(2, 3) = Sheet1.[C7]
            .Offset(2, 4) = Sheet1.[C9]
             .Offset(2, 5) = Sheet1.[a13]
             .Offset(2, 6) = Sheet1.[B13]
             .Offset(2, 7) = Sheet1.[C13]
               .Offset(2, 8) = Sheet1.[D13]
               End If
               If Sheet1.[a14].Value <> "" Then
                .Offset(3, 0) = Sheet1.[C1]
            .Offset(3, 1) = Sheet1.[C3]
            .Offset(3, 2) = Sheet1.[C5]
            .Offset(3, 3) = Sheet1.[C7]
            .Offset(3, 4) = Sheet1.[C9]
             .Offset(3, 5) = Sheet1.[a14]
             .Offset(3, 6) = Sheet1.[B14]
             .Offset(3, 7) = Sheet1.[C14]
               .Offset(3, 8) = Sheet1.[D14]
               End If
                If Sheet1.[a15].Value <> "" Then
                .Offset(4, 0) = Sheet1.[C1]
            .Offset(4, 1) = Sheet1.[C3]
            .Offset(4, 2) = Sheet1.[C5]
            .Offset(4, 3) = Sheet1.[C7]
            .Offset(4, 4) = Sheet1.[C9]
             .Offset(4, 5) = Sheet1.[a15]
             .Offset(4, 6) = Sheet1.[B15]
             .Offset(4, 7) = Sheet1.[C15]
               .Offset(4, 8) = Sheet1.[D15]
               End If
               If Sheet1.[a16].Value <> "" Then
              .Offset(5, 0) = Sheet1.[C1]
            .Offset(5, 1) = Sheet1.[C3]
            .Offset(5, 2) = Sheet1.[C5]
            .Offset(5, 3) = Sheet1.[C7]
            .Offset(5, 4) = Sheet1.[C9]
             .Offset(5, 5) = Sheet1.[a16]
             .Offset(5, 6) = Sheet1.[B16]
             .Offset(5, 7) = Sheet1.[C16]
               .Offset(5, 8) = Sheet1.[D16]
               End If
                If Sheet1.[a17].Value <> "" Then
                  .Offset(6, 0) = Sheet1.[C1]
            .Offset(6, 1) = Sheet1.[C3]
            .Offset(6, 2) = Sheet1.[C5]
            .Offset(6, 3) = Sheet1.[C7]
            .Offset(6, 4) = Sheet1.[C9]
             .Offset(6, 5) = Sheet1.[a17]
             .Offset(6, 6) = Sheet1.[B17]
             .Offset(6, 7) = Sheet1.[C17]
               .Offset(6, 8) = Sheet1.[D17]
               End If
                If Sheet1.[a18].Value <> "" Then
                .Offset(7, 0) = Sheet1.[C1]
            .Offset(7, 1) = Sheet1.[C3]
            .Offset(7, 2) = Sheet1.[C5]
            .Offset(7, 3) = Sheet1.[C7]
            .Offset(7, 4) = Sheet1.[C9]
             .Offset(7, 5) = Sheet1.[a18]
             .Offset(7, 6) = Sheet1.[B18]
             .Offset(7, 7) = Sheet1.[C18]
               .Offset(7, 8) = Sheet1.[D18]
               End If
                If Sheet1.[a19].Value <> "" Then
                 .Offset(8, 0) = Sheet1.[C1]
            .Offset(8, 1) = Sheet1.[C3]
            .Offset(8, 2) = Sheet1.[C5]
            .Offset(8, 3) = Sheet1.[C7]
            .Offset(8, 4) = Sheet1.[C9]
             .Offset(8, 5) = Sheet1.[a19]
             .Offset(8, 6) = Sheet1.[B19]
             .Offset(8, 7) = Sheet1.[C19]
               .Offset(8, 8) = Sheet1.[D19]
               End If
                If Sheet1.[a20].Value <> "" Then
              .Offset(9, 0) = Sheet1.[C1]
            .Offset(9, 1) = Sheet1.[C3]
            .Offset(9, 2) = Sheet1.[C5]
            .Offset(9, 3) = Sheet1.[C7]
            .Offset(9, 4) = Sheet1.[C9]
             .Offset(9, 5) = Sheet1.[a20]
             .Offset(9, 6) = Sheet1.[B20]
             .Offset(9, 7) = Sheet1.[C20]
               .Offset(9, 8) = Sheet1.[D20]
               End If
                If Sheet1.[a21].Value <> "" Then
                 .Offset(10, 0) = Sheet1.[C1]
            .Offset(10, 1) = Sheet1.[C3]
            .Offset(10, 2) = Sheet1.[C5]
            .Offset(10, 3) = Sheet1.[C7]
            .Offset(10, 4) = Sheet1.[C9]
             .Offset(10, 5) = Sheet1.[a21]
             .Offset(10, 6) = Sheet1.[B21]
             .Offset(10, 7) = Sheet1.[C21]
               .Offset(10, 8) = Sheet1.[D21]
               End If
                If Sheet1.[a22].Value <> "" Then
                 .Offset(11, 0) = Sheet1.[C1]
            .Offset(11, 1) = Sheet1.[C3]
            .Offset(11, 2) = Sheet1.[C5]
            .Offset(11, 3) = Sheet1.[C7]
            .Offset(11, 4) = Sheet1.[C9]
             .Offset(11, 5) = Sheet1.[a22]
             .Offset(11, 6) = Sheet1.[B22]
             .Offset(11, 7) = Sheet1.[C22]
               .Offset(11, 8) = Sheet1.[D22]
               End If
                If Sheet1.[a23].Value <> "" Then
                 .Offset(12, 0) = Sheet1.[C1]
            .Offset(12, 1) = Sheet1.[C3]
            .Offset(12, 2) = Sheet1.[C5]
            .Offset(12, 3) = Sheet1.[C7]
            .Offset(12, 4) = Sheet1.[C9]
             .Offset(12, 5) = Sheet1.[a23]
             .Offset(12, 6) = Sheet1.[B23]
             .Offset(12, 7) = Sheet1.[C23]
               .Offset(12, 8) = Sheet1.[D23]
               End If
                If Sheet1.[a24].Value <> "" Then
                 .Offset(13, 0) = Sheet1.[C1]
            .Offset(13, 1) = Sheet1.[C3]
            .Offset(13, 2) = Sheet1.[C5]
            .Offset(13, 3) = Sheet1.[C7]
            .Offset(13, 4) = Sheet1.[C9]
             .Offset(13, 5) = Sheet1.[a24]
             .Offset(13, 6) = Sheet1.[B24]
             .Offset(13, 7) = Sheet1.[C24]
               .Offset(13, 8) = Sheet1.[D24]
               End If
                If Sheet1.[a25].Value <> "" Then
                 .Offset(14, 0) = Sheet1.[C1]
            .Offset(14, 1) = Sheet1.[C3]
            .Offset(14, 2) = Sheet1.[C5]
            .Offset(14, 3) = Sheet1.[C7]
            .Offset(14, 4) = Sheet1.[C9]
             .Offset(14, 5) = Sheet1.[a25]
             .Offset(14, 6) = Sheet1.[B25]
             .Offset(14, 7) = Sheet1.[C25]
               .Offset(14, 8) = Sheet1.[D25]
               End If
                If Sheet1.[a26].Value <> "" Then
                 .Offset(15, 0) = Sheet1.[C1]
            .Offset(15, 1) = Sheet1.[C3]
            .Offset(15, 2) = Sheet1.[C5]
            .Offset(15, 3) = Sheet1.[C7]
            .Offset(15, 4) = Sheet1.[C9]
             .Offset(15, 5) = Sheet1.[a26]
             .Offset(15, 6) = Sheet1.[B26]
             .Offset(15, 7) = Sheet1.[C26]
               .Offset(15, 8) = Sheet1.[D26]
               End If
           If Sheet1.[a27].Value <> "" Then
             .Offset(16, 0) = Sheet1.[C1]
            .Offset(16, 1) = Sheet1.[C3]
            .Offset(16, 2) = Sheet1.[C5]
            .Offset(16, 3) = Sheet1.[C7]
            .Offset(16, 4) = Sheet1.[C9]
             .Offset(16, 5) = Sheet1.[a27]
             .Offset(16, 6) = Sheet1.[B27]
             .Offset(16, 7) = Sheet1.[C27]
               .Offset(16, 8) = Sheet1.[D27]
               End If
                If Sheet1.[a28].Value <> "" Then
             .Offset(17, 0) = Sheet1.[C1]
            .Offset(17, 1) = Sheet1.[C3]
            .Offset(17, 2) = Sheet1.[C5]
            .Offset(17, 3) = Sheet1.[C7]
            .Offset(17, 4) = Sheet1.[C9]
             .Offset(17, 5) = Sheet1.[a28]
             .Offset(17, 6) = Sheet1.[B28]
             .Offset(17, 7) = Sheet1.[C28]
               .Offset(17, 8) = Sheet1.[D28]
               End If
                If Sheet1.[a29].Value <> "" Then
             .Offset(18, 0) = Sheet1.[C1]
            .Offset(18, 1) = Sheet1.[C3]
            .Offset(18, 2) = Sheet1.[C5]
            .Offset(18, 3) = Sheet1.[C7]
            .Offset(18, 4) = Sheet1.[C9]
             .Offset(18, 5) = Sheet1.[a29]
             .Offset(18, 6) = Sheet1.[B29]
             .Offset(18, 7) = Sheet1.[C29]
               .Offset(18, 8) = Sheet1.[D29]
               End If
                If Sheet1.[a30].Value <> "" Then
             .Offset(19, 0) = Sheet1.[C1]
            .Offset(19, 1) = Sheet1.[C3]
            .Offset(19, 2) = Sheet1.[C5]
            .Offset(19, 3) = Sheet1.[C7]
            .Offset(19, 4) = Sheet1.[C9]
             .Offset(19, 5) = Sheet1.[a30]
             .Offset(19, 6) = Sheet1.[B30]
             .Offset(19, 7) = Sheet1.[C30]
               .Offset(19, 8) = Sheet1.[D30]
               End If
               If Sheet1.[a31].Value <> "" Then
             .Offset(20, 0) = Sheet1.[C1]
            .Offset(20, 1) = Sheet1.[C3]
            .Offset(20, 2) = Sheet1.[C5]
            .Offset(20, 3) = Sheet1.[C7]
            .Offset(20, 4) = Sheet1.[C9]
             .Offset(20, 5) = Sheet1.[a31]
             .Offset(20, 6) = Sheet1.[B31]
             .Offset(20, 7) = Sheet1.[C31]
               .Offset(20, 8) = Sheet1.[D31]
               End If
                If Sheet1.[a32].Value <> "" Then
             .Offset(21, 0) = Sheet1.[C1]
            .Offset(21, 1) = Sheet1.[C3]
            .Offset(21, 2) = Sheet1.[C5]
            .Offset(21, 3) = Sheet1.[C7]
            .Offset(21, 4) = Sheet1.[C9]
             .Offset(21, 5) = Sheet1.[a32]
             .Offset(21, 6) = Sheet1.[B32]
             .Offset(21, 7) = Sheet1.[C32]
               .Offset(21, 8) = Sheet1.[D32]
               End If
                      ' .Offset(1, 6) = Sheet1.[G1].Text
      End With
End Sub

وهذا هو الملف

 

كود ترحيل الفاتورة.xlsm

[حسين مامون]

تفضل اخي

 

كود ترحيل الفاتورة.xlsm

[هانى محمد]

بوركت استاذ حسين كود رائع

جعله الله فى ميزان حسناتك ورحم الله والديك وغفر الله لك ووسع الله فى رزقك

[حسين مامون]

شكرا اخي 

ولك نصيب من الاجر من ما دعوت لي ان شاء الله