Copy and Paste multiple cells with VBA

user_15961800 0
Viewed 529

I'm trying to automate a macro in an Excel Worksheet. I have a big table on the first worksheet with a variable number of rows, and I need to create a number of "plates" (group of 5 rows with certain data) for each row of the main worksheet (posted in the attached image). The plates need to be displayed as in the screenshot in order to be exported in a .pdf file (2 on the same level until the last one)

This is the code I came up to using macro recording and other macro found around and already working for me (pdf printing):

Sheets("Summary").Select
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
first_row = "A2"
sec_row = "F2"
For i = 1 To lastRow

Sheets("Foglio1").Select
Range("S3:V7").Select
Selection.Copy
Range("first_row:first_row+4").Select
ActiveSheet.Paste
Range("sec_row:sec_row+4").Select
ActiveSheet.Paste

i = i + 2
Next

After this I have a code part where I export the selected area as pdf (easy and is working).

Second worksheet where all the plates are displayed

worksheet-function copy-paste vba excel
2 Answers

Assuming your summary sheet is like this

SUmmary Table

then try

Option Explicit

Sub CreatePDF()

    Dim wb As Workbook, ws As Worksheet, wsPDF As Worksheet
    Dim iLastRow As Long, ar(1 To 5, 1 To 1), rng As Range
    Dim i As Long, r As Long, c As Integer, k As Integer
   
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Summary")
    Set wsPDF = wb.Sheets("Foglio1")
    'wsPDF.Cells.Clear

    ' fixed
    ar(1, 1) = "Factory s.r.l."
    ar(2, 1) = "Ph. +39 0000 00000"
    ar(3, 1) = "Web www.website.net"
   
    iLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    r = 2 ' start row
    c = 1 ' column A
    For i = 2 To iLastRow
        ar(4, 1) = "JOB " & ws.Cells(i, "A")
        ar(5, 1) = "ORDER " & ws.Cells(i, "B")
       
        ' fill plate
        Set rng = wsPDF.Cells(r, c).Resize(5, 1)
        rng.Value2 = ar
       
        ' merge cells
        For k = 1 To 5
            With rng.Cells(k, 1).Resize(1, 4)
                .Merge
                .HorizontalAlignment = xlCenter
                .Font.Bold = True
            End With
        Next
        
        ' move to next plate
        If i Mod 2 = 0 Then
            c = 6 ' column F
        Else
            c = 1 ' column A
            r = r + 6
        End If
    Next
    MsgBox "Done"
End Sub
user_127045930

OK, there are a number of "I wish this would work"-type parts of your code at present, and probably more questions than answers right now.

It seems like your output sheet "Foglio1" is currently formatted to accept a "plate" in six locations. If your intent is that these six should be from different rows of the main sheet "Summary", that's a little more complicated than putting six copies of each row up for printing.

With all the switching back and forth between sheets, it's worth working with some Range and Worksheet variables to keep the screen from getting too busy.

There are a number of activities to separate out:

  • get "plate" information from main sheet
  • format appropriately
  • update summary sheet
  • output to pdf if the time is right

So my overall scheme would look like:

' set up plate locations in output sheet Array("A2","F2","A8",...)
' ---- set up range of records to scan (ScanRange) (only column A, other data by .Offset)
For Each ACell in ScanRange
    ' ---- get data from this record e.g.
    phone = ACell.Offset(0,5).Text
    ' ---- fill next plate (Range) in output sheet e.g.
    whichPlate = whichPlate + 1 ' & cycle
    Set plate = Range(plates(whichPlate))
    plate.Offset(1,0).Value = "Ph. " & phone 'etc.
    ' ---- send to pdf if appropriate
    ' ---- clean up output sheet if needed
Next ACell

' ---- send last batch to pdf
user_44754680
Related