VBA List Value Into Multiple Document Pages

Keyboardist

Board Regular
Joined
Mar 2, 2016
Messages
54
Hey there,

I have created a spreadsheet that looks like a legal document.
I am trying to populate this "document" with a list from another workbook.
I have created multiple "pages" of this document, so it simply goes down the rows.

This has left me with something that looks like:
24 empty rows to fill
11 rows to skip
24 empty
11 skip
etc...

How do I take my list of 100 items and auto-fill each set of 24 empty rows?

Any help is appreciated.
Thank you.
 
Last edited:

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Assuming you consistently have 35 rows to a page and your first empty row begins on row 1 with your list beginning in column A2 down on sheet 1 of workbook 2. Also assume both workbooks are opened in the order of the index
Code:
Sub fillBlanks()
Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet, c As Range, r As Long
Set wb1 = Workbooks(1) 'Use actual workbook name (inclued path if in different directory)
Set wb2 = Workbooks(2) 'Use actual workbook name (inclued path if in different directory)
Set sh1 = wb1.Sheets(1) 'Edit sheet name
Set sh2 = wb2.Sheets(1) 'Edit sheet name
    r = 1
    For i = 2 To 101
        cnt = sh2.Range(sh2.Cells(i, 1), sh2.Cells(i, Columns.Count).End(xlToLeft)).Cells.Count
        sh2.Cells(i, 1).Resize(1, cnt).Copy sh1.Cells(r, 1).Resize(24, cnt)
        cnt = ""
        r = r + 35
    Next
End Sub
 
Upvote 0
Code:
    r = 1
    For i = 2 To 101
        cnt = sh2.Range(sh2.Cells(i, 1), sh2.Cells(i, Columns.Count).End(xlToLeft)).Cells.Count
        sh2.Cells(i, 1).Resize(1, cnt).Copy sh1.Cells(r, 1).Resize(24, cnt)
        cnt = ""
        r = r + 35
    Next
End Sub

The code is duplicating each item 24 times instead of going down the list consecutively.
Example:
My list on the left. What the code is doing on the right
1
1
21
3
42
52
6
73
83
9
104


4

<tbody>
</tbody>


What I'm expecting is something like this:
11
22
3
43
54
6
75
86
9
107
8

<tbody>
</tbody>
 
Upvote 0
I want to be clear on what you expect. Is it:
1. Each page will be 35 rows
2. page one will list items 1-through 24 from the list on sheet 2.
3. page two will list items 25 through 48 from sheet 2
4. page three will list items 49 through 72 from sheet 2
5. page four will list items 73 through 96 from sheet 2
6. page five will list the remainder of the 100 items from sheet 2 and then what happens?
 
Upvote 0
1. Each page will be 35 rows
yes

2. page one will list items 1-through 24 from the list on sheet 2.
yes

3. page two will list items 25 through 48 from sheet 2
yes

4. page three will list items 49 through 72 from sheet 2
yes

5. page four will list items 73 through 96 from sheet 2
yes

6. page five will list the remainder of the 100 items from sheet 2 and then what happens?
Then I print the pages.
100 is a practice number. The actual number could be anywhere from 1 to 400.
 
Upvote 0
See if this is more to your liking.

Code:
Sub fillBlanks2()
Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet, c As Range, r As Long
Set wb1 = Workbooks(1) 'Use actual workbook name (inclued path if in different directory)
Set wb2 = Workbooks(2) 'Use actual workbook name (inclued path if in different directory)
Set sh1 = wb1.Sheets(1) 'Edit sheet name
Set sh2 = wb2.Sheets(1) 'Edit sheet name
    lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
    r = 1
    For i = 2 To lr Step 24
        cnt = sh2.Range(sh2.Cells(i, 1), sh2.Cells(i, Columns.Count).End(xlToLeft)).Cells.Count
        sh2.Cells(i, 1).Resize(24, cnt).Copy sh1.Cells(r, 1)
        cnt = ""
        r = r + 35
    Next
End Sub
 
Upvote 0
See if this is more to your liking.

Code:
Sub fillBlanks2()
Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet, c As Range, r As Long
Set wb1 = Workbooks(1) 'Use actual workbook name (inclued path if in different directory)
Set wb2 = Workbooks(2) 'Use actual workbook name (inclued path if in different directory)
Set sh1 = wb1.Sheets(1) 'Edit sheet name
Set sh2 = wb2.Sheets(1) 'Edit sheet name
    lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
    r = 1
    For i = 2 To lr Step 24
        cnt = sh2.Range(sh2.Cells(i, 1), sh2.Cells(i, Columns.Count).End(xlToLeft)).Cells.Count
        sh2.Cells(i, 1).Resize(24, cnt).Copy sh1.Cells(r, 1)
        cnt = ""
        r = r + 35
    Next
End Sub

That's it! Thank you so much! I knew it had to be simple!
 
Upvote 0
I've run into an issue. I'm getting an error message "Copy method of range class failed".
I tested this code first and I know it works, so what did I mess up? Here's the code I'm using.

Code:
Sub GetInfo()'Dim current workbook
    Dim filename As String, User As String
    Dim nameMonth As String, nameYear As String, lastDay As String, firstDay As String
    Dim ClearRng As Range, wb As Workbook, ws As Worksheet, wsCont As Worksheet


'Set Sheets for current workbook
    Set wb = Workbooks("Monthly Tax Report")
    Set ws = wb.Worksheets("Monthly Tax Report")
    Set wsCont = wb.Worksheets("Continuation")




'Dim new workbook
Dim lrow1 As Long, lrow2 As Long, lrow3 As Long
Dim xl0 As New Excel.Application, xlw As New Excel.Workbook
Dim srcName1 As String, srcName2 As String, srcName3 As String
Dim srcSht1 As Worksheet, srcSht2 As Worksheet, srcSht3 As Worksheet
Dim rng1 As Range, rng2 As Range, rng3 As Range


'Get first and last day of month to use in filename
nameYear = Worksheets("Monthly Tax Report").TextBox1.Text
nameMonth = Worksheets("Monthly Tax Report").ComboBox1.Text


        'Format date for filepath
            firstDay = Format("1/" & nameMonth & "/" & nameYear, "yyyy-mm-dd")
            lastDay = Format(dhLastDayInMonth("1/" & nameMonth & "/" & nameYear), "yyyy-mm-dd")


        'File Name for Sales History Download
            User = Environ("UserName")
            filename = "C:\Users\" & User & "\Downloads\VinoShipper Sales " & _
                       firstDay & " - " & lastDay & ".xlsx"
 
        'Make sure filepath is valid
            If Dir(filename, vbDirectory) = "" Then
                   MsgBox "The filepath: " & vbCrLf & _
                   filename & _
                   vbCrLf & " is not valid. Make sure you have downloaded the correct file."
                   Exit Sub
            End If
       
                'Sheet names - subject to change
                    srcName1 = "Winery Permit Sales"
                    srcName2 = "VinoShipper Permit Sales"
                    srcName3 = "Product Performance"
                         
                'Open downloaded file and Set Worksheets
                    Set xlw = xl0.Workbooks.Open(filename)
                    Set srcSht1 = xl0.Sheets(srcName1)
                    Set srcSht2 = xl0.Sheets(srcName2)
                    Set srcSht3 = xl0.Sheets(srcName3)
                    
                'Find last row for each sheet
                    lrow1 = srcSht1.Range("A1").End(xlDown).Row
                    lrow2 = srcSht2.Range("A1").End(xlDown).Row
                    lrow3 = srcSht3.Range("A1").End(xlDown).Row
            
                    
Dim sh1 As Worksheet, cnt As Long, i As Long, r As Long
Set sh1 = wb.Sheets("Sheet3")


    lr = srcSht2.Cells(Rows.Count, 1).End(xlUp).Row
    r = 1
    For i = 2 To lr Step 24
        cnt = srcSht2.Range(srcSht2.Cells(i, 1), srcSht2.Cells(i, Columns.Count).End(xlToLeft)).Cells.Count
        srcSht2.Cells(i, 1).Resize(24, cnt).Copy sh1.Cells(r, 1)
        cnt = ""
        r = r + 35
    Next
    
xlw.Save
xlw.Close
Set xl0 = Nothing
Set xlw = Nothing


    End Sub
 
Upvote 0
Your problem probably lies in the text I have in red font. You need to make sure that the variables refer to the correct workbooks and sheets.
Code:
[COLOR=#B22222]Dim sh1 As Worksheet, c[/COLOR]nt As Long, i As Long, r As Long
[COLOR=#B22222]Set sh1 = wb.Sheets("Sheet3")[/COLOR]
    lr = srcSht2.Cells(Rows.Count, 1).End(xlUp).Row
    r = 1
    For i = 2 To lr Step 24
        cnt = srcSht2.Range(srcSht2.Cells(i, 1), srcSht2.Cells(i, Columns.Count).End(xlToLeft)).Cells.Count
        srcSht2.Cells(i, 1).Resize(24, cnt).Copy [COLOR=#B22222]sh1.[/COLOR]Ce[COLOR=#B22222][/COLOR]lls(r, 1)
        cnt = ""
        r = r + 35
    Next

You converted the other sheets, but apparently overlooked that one. You have all your variables already defined, you just needed to plug them in where I was using generic code. If you can't figure it out, I will take a look tomorrow. Bed time now.
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,184
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top