با سلام
به دلیل اینکه سلول خالی در بین اعداد دارید راه حل فرمولی سخت و پیچیده میشه با عرض پوزش از عدم همخوانی جواب با محل پرسش ، این کدها رو امتحان کنید.
فراموش نشه ابتدا از باید از روشی که دوستمون توضیح دادن ستون ها رو جداسازی و بعد کد های زیر رو اجرا کنید.
کد:
Sub test()
Dim r, i, j, p As Long
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
'˜í ˜ÑÏä ÓÊæä åÇí Ïæã ÊÇ äÌã
For i = 2 To 5
r = Cells(Rows.Count, i).End(xlUp).Row
Range(Cells(1, i), Cells(r, i)).Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Next i
'ÍÐÝ Óáæá åÇí ÎÇáí Èíä ÇÚÏÇÏ ÓÊæä åÇ
On Error Resume Next
Columns("A").SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
On Error GoTo 0
'ÇÖÇÝå ˜ÑÏä ÕÝÑ Èå ÇÈÊÏÇí ÇÚÏÇÏ
p = Cells(Rows.Count, "a").End(xlUp).Row
For j = 2 To p
Cells(j, 1).NumberFormat = "@"
Cells(j, 1).Value = "0" & Cells(j, 1).Value
Next j
Next ws
End Sub
علاقه مندی ها (Bookmarks)