פריסה של ערכים

[mashooga1]

פריסה של ערכים

שלום, ברשותי קובץ רשימת לקוחות עם 700 לקוחות .
יש דרך לסדר אותו עם נוסחאות לפי התנאים הבאים?
1. פריסת הלקוחות לרוחב ככה שיהיה רווח של עמודה אחת בין כל לקוח ולקוח
2. כל עמודה עם לקוח תהיה ברוחב של עמודה B ברוחב של 150 פיקסלים
3. כל עמודה עם לקוח תהיה עם גבולות מלאים
4. כל עמודה עם לקוח תהיה במילוי צבע
גליון 1 מייצג את הקובץ המקורי, גליון 2 מייצג את הקובץ הרצוי.
תודה רבה.

 

[u333]

המקרו המצ"ב ישמח לבצע עבורך את המשימה - בגיליון Sheet3

הכנס את המקרו למודול רגיל.
עצב את תא C4 לפי הדוגמא הרצויה בגיליון היעד כגון: צבע מילוי, צבע גופן, גבולות תאים, וכד'.
הפעל את המקרו מתוך גיליון Sheet1

Sub CopyList()
Application.ScreenUpdating = 0
k = Application.CountA(Range("B:B"))
lr = Cells(Rows.Count, 2).End(xlUp).Row
    For n = 6 To lr
        Cells(n, 2).Copy Sheets("Sheet3").Cells(6, (n - 5) * 2)
        With Sheets("Sheet3").Columns((n - 5) * 2)
           .ColumnWidth = 20
        End With
        Sheets("Sheet1").Range("C4").Copy
        Sheets("Sheet3").Columns((n - 5) * 2).PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False
    Next
Sheets("Sheet3").Activate
[A1].Select
Application.ScreenUpdating = 1
End Sub