20170727xlVBA generate multi-page list based on total list and template

Sub Countingdown () Dim Dic As Object ' for categorical statistics Dim i As Long dim countdown As Long ' up to a few messages per page Dim x As Long , y as Long Dim page As Long ' page Dim Index As Long ' per page ordinal Dim Sht As Worksheet Dim startrow As Long, End Row as Long ' page start line Dim mrng as Range ' template area Set mrng = Sheets ("Accept template").        Range ("A1:j26") ' Save template area row height with column width with Sheets ("Total list") page = 0 ' pagination ordinal Index = 0 ' name ordinal ' Start dividing first page        i = 2 StartRow = 2 Countdown = 36 ' Start reciprocal Information Bar Set Dic = CreateObject ("Scripting.Dictionary") Do While. Cells (i, 1). Value <> "' Loop continuous non-empty line countdown = CountDown-1 ' Countdown-1 Key = Trim (. Cells (i, 4). Text) ' Get classification if Len (key) > 2 Then Key = "Drive" ' Handle classification if dic.exists (key) = False Then ' if new                Category Dic (Key) = 1 ' Start count countdown = CountDown-1 ' categorical statistics need to occupy one line Else DIC (key) = DIC (key) + 1 ' If not new category, category Count            End if If countdown = 0 Or. Cells (i + 1, 1).                 Value = "Then ' if full page, or end page = page + 1 ' new page NewName =" Accept List "& Page ' get new table name                Copymodel NewName ' Add list table Set Sht = Sheets (NewName) Endrow = i ' Save end Line ' Initialize the row number of each page x = 0 y = 1 ' Index = 0 ' instead of ' inside '                        Loop for every k in Dic.keys ' Loop each category for n = startrow to Endrow ' Loop just counting everyone ' Processing category ' Key = Trim (. Cells (n, 4).                        Text) if Len (key) > 2 Then Key = "Drive" If category matches, the output                                If Key = k Then ' per full 18 lines, replace if x =                      x = 0 y = 6 End If ' cumulative serial number      index = index + 1 ' cumulative information number (including category) x = x + 1 ' outputs the corresponding information Sht.cells (3 + x, y). V Alue = Index Sht.cells (3 + x, y + 1). Value =. Cells (n, 1). Value Sht.cells (3 + x, y + 2). Value = "'" &. Cells (n, 2).                                                            Value End If Next N                    ' 18 rows or more, If x = + then x = 0 y = 6 End If x = x + 1 ' Output categorical statistic results sht.cells (3 + x, y + 2). V                Alue = k & Dic (k) & "People" Next K ' Keep template row high For x = 1 to Sht.rows (1). RowHeight = Mrng.rows (x).        RowHeight        Next x for y = 1 to ten sht.columns (y). ColumnWidth = Mrng.columns (y).                 ColumnWidth next y ' start next startrow = Endrow + 1 countdown = 36 Set Dic = CreateObject ("Scripting.Dictionary") End If i = i + 1 L OOP End with Set Sht = no set Dic = NothingEnd SubSub Copymodel (ByVal NewName as String) Dim Msht as Work Sheet Dim Newsht as Worksheet set Msht = Sheets ("Accept template") Msht.copy after:=sheets (sheets.count) Set Newsht = She ETS (Sheets.count) on Error Resume Next Sheets (NewName). Delete on Error GoTo 0 newsht.name = newnameend Sub

　　

20170727xlVBA generate multi-page list based on total list and template