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

[zizo747]

السلام عليكم و رحمة الله

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

Copy (2) of REMITANCE FORM5.rar

[احمدزمان]

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

قيل

لكل شيء اذا ما تم نقصان

فلا يغر بطيب العيش انسان

اخي الكريم آمل التجربة و اخباري بالنتيجة

Sub MoveValue_Amend()

	Range("Q15:S15").Select

	ActiveCell.FormulaR1C1 = "=R[-13]C[-10]"

	Range("G2:H2").Select

	'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Dim EndRow As Long

 EndRow1 = Sheets(2).Range("A1").CurrentRegion.Rows.Count

For EndRow = 2 To EndRow1

If Sheets(2).Cells(EndRow, 1).Value = Sheets(4).Cells(2, 7).Value Then

 Sheets(2).Cells(EndRow, 1).Value = EndRow

 Sheets(2).Cells(EndRow, 2).Value = Sheets(4).Cells(15, 17).Value

 Sheets(2).Cells(EndRow, 3).Value = Sheets(4).Cells(5, 3).Value

 Sheets(2).Cells(EndRow, 4).Value = Sheets(4).Cells(42, 7).Value

 Sheets(2).Cells(EndRow, 5).Value = Sheets(4).Cells(5, 6).Value

 Sheets(2).Cells(EndRow, 6).Value = Sheets(4).Cells(4, 41).Value

 Sheets(2).Cells(EndRow, 7).Value = Sheets(4).Cells(5, 9).Value

 Sheets(2).Cells(EndRow, 8).Value = Sheets(4).Cells(5, 13).Value

 Sheets(2).Cells(EndRow, 9).Value = Sheets(4).Cells(10, 3).Value

 Sheets(2).Cells(EndRow, 10).Value = Sheets(4).Cells(8, 3).Value

 Sheets(2).Cells(EndRow, 11).Value = Sheets(4).Cells(8, 5).Value

 Sheets(2).Cells(EndRow, 12).Value = Sheets(4).Cells(8, 10).Value

 Sheets(2).Cells(EndRow, 13).Value = Sheets(4).Cells(8, 14).Value

  Sheets(2).Cells(EndRow, 14).Value = Sheets(4).Cells(5, 16).Value

 Sheets(2).Cells(EndRow, 15).Value = Now()

 Sheets(2).Cells(EndRow, 16).Value = Environ("username")

 MsgBox (" Printed and saved")

GoTo 9

Next

9

End Sub

حيث تم وضع حلقة بحث في العمود A

فاذا تطابق الرقم مع رقم الأمر المعدل يتم الكتابة