گاهی اوقات ممکن است یک کاربرگ از شخص دیگری دریافت کنید و برای کار روی اطلاعات ارائه شده به فضایی نیاز دارید. به عنوان مثال، ممکن است برای شما مفید باشد که چند ردیف خالی بین هر یک از ردیف های اصلی در داده های اصلی اضافه کنید. در حالی که این کار را می توان به راحتی با استفاده از منوی Insert انجام داد، اما می تواند به سرعت خسته کننده شود - به خصوص اگر تعداد زیادی ردیف دارید که می خواهید آنها را پخش کنید.
ماکرو زیر در این شرایط کمک فوق العاده ای به شما می کند. تنها کاری که باید انجام دهید این است که ردیف اول داده ها را انتخاب کنید. هنگامی که ماکرو را اجرا می کنید، از شما می پرسد که چند ردیف خالی را می خواهید بین ردیف های اصلی قرار دهید. وقتی عددی را ارائه می کنید، ماکرو از داده ها عبور می کند و شروع به درج ردیف های خالی می کند. هنگامی که اولین سلول خالی پس از داده اصلی شناسایی شود، ماکرو متوقف می شود.
Sub SpreadOut()
Dim iBlanks As Integer
Dim J As Integer
iBlanks = InputBox("How many blank rows?", "Insert Rows")
ActiveCell.Offset(1, 0).Select
While ActiveCell.Value > "" And iBlanks > 0
For J = 1 To iBlanks
Selection.EntireRow.Insert
Next J
ActiveCell.Offset(iBlanks + 1, 0).Select
Wend
End Sub