تعديل كود الاستراد والتصدير الى الاكسيل

[بلال بلال]

السلام عليكم

لدي ورقة Horaire2027    اريد ترحيل البيانات الى ورقة Feuil1 و  Feuil12 و Feuil13

 

            1- ترحيل البيانات الى الورقة Feuil1 الحقول بالون الأزرق لا تفرغ الحقول عند الترحيل 

            2-ترحيل البيانات الى الورقة Feuil12 الحقول بالون الأصفر وعند الترحيل تفرغ الحقول

            3-ترحيل البيانات الى الورقة Feuil13 الحقول بالون الأحمر وعند الترحيل تفرغ الحقول

Horaire-18-06-2026-(04.12.06) (3).xlsb

[أبومروان]

وعليكم السلام ورحمه الله وبركاته 

 

 

اتفضل الكود بالطلب الاول لعله يكون المطلوب 👇

Sub TransferDataValues()

    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim nextRow As Long

    Set wsSrc = ThisWorkbook.Worksheets("Horaire2027")
    Set wsDst = ThisWorkbook.Worksheets("Feuil1")

    nextRow = wsDst.Cells(wsDst.Rows.Count, "A") '.End(xlUp).Row
    If nextRow < 5 Then
        nextRow = 5
    Else
        nextRow = nextRow
    End If

    wsDst.Cells(nextRow, "A").Resize(4, 9).Value = wsSrc.Range("B3:J6").Value

End Sub

 اتفضل الكود بالطلب التاني لعله يكون المطلوب 👇

Sub Transfe12()

    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
    Dim nextRow As Long

    Set wsSrc = ThisWorkbook.Worksheets("Horaire2027")
    Set wsDst = ThisWorkbook.Worksheets("Feuil12")

    nextRow = wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Row
    If nextRow < 5 Then
        nextRow = 5
    Else
        nextRow = nextRow + 1
    End If

    wsDst.Cells(nextRow, "A").Resize(1, 9).Value = wsSrc.Range("B9:J9").Value

End Sub

 اتفضل الكود بالطلب التالت لعله يكون المطلوب 👇

Sub Transfe13()

    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
    Dim nextRow As Long

    Set wsSrc = ThisWorkbook.Worksheets("Horaire2027")
    Set wsDst = ThisWorkbook.Worksheets("Feuil13")

    nextRow = wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Row
    If nextRow < 5 Then
        nextRow = 5
    Else
        nextRow = nextRow + 1
    End If

    wsDst.Cells(nextRow, "A").Resize(1, 9).Value = wsSrc.Range("B13:J13").Value
    
    wsSrc.Range("B13:J13").ClearContents
End Sub

 

Copy of Horaire-18-06-2026-(04.12.06) (3).xlsb

[بلال بلال]

استاذ يارك لله فيك

استاذ الحقول بالون الابيض هل تسطيع تعديل بترحيل مرة واحدة 

استاذ ورقة Feuil1 قد قمت بتعديل عليها 

الحقول يكون في صف واحد

استاذ الحقول بالون الاصفر يتم افراغ الحقول

استاذ عند تكون الحقول فارغ لا يتم الترحيل

بارك الله فيك

Copy of Horaire-18-06-2026-(04.12.06) (3).xlsb