با عرض سلام، جدولی از افراد داریم که می خواهیم، برای هر فرد یک کارنامه صادر شود،
کد آن را نوشته ام:
اما جواب به این صورت دیده می شود:
چه تغییر در کد، بالاخص دو خط
بدهم که فرمت سلول های مرج شده را به همان شکل و رنگ نشان بدهد؟
کد آن را نوشته ام:
کد:
Sub moghayese_va_darj_Range_motanazer()
Dim file_digar As Workbook
Dim Sheet_digar As Worksheet
Dim Sheet_hazer As Worksheet, Sheet_hazer2 As Worksheet
Dim rng As Range, rng2 As Range
tedade_peida_shode = 0
'Set file_digar = Workbooks.Open("D:\___ziafat\___Modarresin\modarresin-hamayesh-98.xlsx")
Set Sheet_hazer = ThisWorkbook.Worksheets("yek_modares")
Set Sheet_digar = ThisWorkbook.Worksheets("modar_ama")
Set Sheet_digar2 = ThisWorkbook.Worksheets("asatid")
ThisWorkbook.Activate
LastRow = Sheet_hazer.Range("D" & Rows.Count).End(xlUp).Row
LastRow2 = Sheet_digar2.Range("L" & Rows.Count).End(xlUp).Row
i = 1
For j = 2 To 4
modarres = Sheet_digar.Cells(j, 12).Value
hozoor = Sheet_digar.Cells(j, 39).Value
' shomarandeh
Sheet_hazer.Cells(1, 5).Value = "j: " & j
Sheet_hazer.Cells(1, 6).Value = "i: " & i
Sheet_hazer.Cells(1, 7).Value = "modarres: " & modarres
j2 = (j - 1) * 26
Sheet_hazer.Cells(1, 1).Copy _
Sheet_hazer.Cells(1 + j2, 1)
Sheet_hazer.Cells(1, 2).Copy _
Sheet_hazer.Cells(1 + j2, 2)
Sheet_hazer.Cells(1, 3).Copy _
Sheet_hazer.Cells(1 + j2, 3)
Sheet_hazer.Cells(2, 1).Copy _
Sheet_hazer.Cells(2 + j2, 1)
Sheet_hazer.Cells(2 + j2, 2) = modarres
Sheet_hazer.Cells(2, 3).Copy _
Sheet_hazer.Cells(2 + j2, 3)
For i = 3 To 25
Sheet_hazer.Cells(i + j2, 1).Value = Sheet_hazer.Cells(i, 1)
Sheet_hazer.Cells(i + j2, 2) = Sheet_hazer.Cells(i, 2)
Sheet_hazer.Cells(i, 3).Copy _
Sheet_hazer.Cells(i + j2, 3)
Next i
Next j
End Sub
چه تغییر در کد، بالاخص دو خط
کد:
Sheet_hazer.Cells(i + j2, 1).Value = Sheet_hazer.Cells(i, 1)
Sheet_hazer.Cells(i + j2, 2) = Sheet_hazer.Cells(i, 2)
فایل های پیوست شده
کامنت