This is a very simple Excel macro created by one of our fellows in the early days of Oliveria, but it may cover most of your essential needs when you need to create hunreds of simple badges with custom design in Excel fast. We hope it will be helpful for you!
Want more functions? Contact us!
Download:
VBA code:
' A simple tool to prepare for printing simple custom badges
' Oliveria 2017
' Questions and comments welcome http://oliveria.ru
' Want to do something special, but not enough functionality here? Contact us and we will do it for you!
Option Explicit
Sub Make_Me_Some_Badges_Prego()
Dim i, k, LastRow, j, s, n As Integer
Dim cell As Range
Application.ScreenUpdating = False
LastRow = Worksheets("Participants").Cells(Rows.Count, 1).End(xlUp).Row
ReDim LastNames(LastRow + 10), FirstNames(LastRow + 10), CompanyNames(LastRow + 10) As String
k = (LastRow - 2) / 10
k = Application.RoundUp(k, 0)
For i = 3 To LastRow
LastNames(i - 3) = Cells(i, 2).Value
FirstNames(i - 3) = Cells(i, 3).Value
CompanyNames(i - 3) = Cells(i, 4).Value
Next i
If k > 1 Then
Worksheets("Result").Select
Range(Cells(1, 1), Cells(50, 10)).Copy
Worksheets("Result").Select
Range(Cells(1, 11), Cells(50, k * 10)).Select
ActiveSheet.Paste
End If
j = Application.RoundUp((LastRow - 2) / 5, 0)
n = 0
For s = 0 To j - 1
For i = 0 To 4
Worksheets("Result").Cells(5 + 10 * i, 1 + s * 5).Value = LastNames(n) & " " & FirstNames(n)
Worksheets("Result").Cells(5 + 10 * i + 3, 1 + s * 5).Value = CompanyNames(n)
n = n + 1
Next i
Next s
Application.ScreenUpdating = True
MsgBox LastRow - 2 & " badges." & Chr(10) & " Sincerely yours, Oliveria."
End Sub