(Solved) – Paste Shapes group in column and rows with conditions


I have some shapes to print in columns and rows format based on the user-defined input Value. there are 3 main inputs based conditions:

1) No of starting label(shapes) to skip
2) No of label(shapes) per Row
3) No of Rows Per page

enter image description here
I have one datasheet which has data in column A (includes shapes) and No of copies to be printed in column B.

This thread is similar to How to Paste Data in Columns and Rows in this way but here is shapes(Group of shapes – picture) instead of data

Option Explicit

Private Sub PrintLabels()
   Dim LabelsToSkip As Integer
   Dim LabelsPerRow As Integer
   Dim RowsPerPage As Integer
   Dim shdata As Worksheet
   Dim shgenerate As Worksheet
   Dim shDesignFormat As Worksheet
   Dim curRow As Long
   Dim curCol As Long
   Dim RowsPerPageCount As Long
   Dim r As Long
   Dim r2 As Long
   Dim Top As Single
   Dim Left As Single
   Dim i As Integer
   Dim shp As Shape

   Set shdata = ThisWorkbook.Sheets("Database")
   Set shgenerate = ThisWorkbook.Sheets("LabelGenerate")
   Set shDesignFormat = ThisWorkbook.Sheets("LabelDesignFormatBeforePrint")


LabelsToSkip = 1
LabelsPerRow = 3
RowsPerPage = 8

   curRow = 1
   curCol = 1
   RowsPerPageCount = 1

   '.Top = myShape.Height   10 '10 is the Vertical gap b/w label
   '.Left = myShape.Left   10 '10 is the Horizontal gap b/w label

   Left = 0
   Top = 0

   For r = 2 To shdata.Range("B" & Rows.Count).End(xlUp).Row
   i = 1
      '======== Copy Shape from Data Sheet============
      shdata.Cells(r, "A").Copy shDesignFormat.Range("B3") 'pasting shape to design sheet before print (to format)

      For r2 = 1 To shdata.Cells(r, "B").Value
         '=====Paste to Generate Sheet ====
    For Each shp In shgenerate.Shapes
        If shp.Top > Top Then
            Top = shp.Top   10 '10 is the Vertical gap b/w label
            Left = shp.Left   10 '10 is the Horizontal gap b/w label
        End If

    Set shp = shDesignFormat.Shapes("Rectangle" & i)



    With Selection
        .Top = Top
        .Left = Left
    End With

      Next r2
      i = i   1

   Next r

   Application.CutCopyMode = False
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *