Customize code for a macro that copies three rows to a new workbook based on a condition

Version 2.

Please remember to add a reference to the Microsoft Scripting Runtime

'#################################################################################################################################
'# requires microsoft scripting runtime
'#################################################################################################################################
     Public Sub pub_sub_ExportRows()

     '#
     '# declare private variables
     '#
          Dim pvt_wbk_New As Excel.Workbook
          Dim pvt_xls_Current As Excel.Worksheet
          
          Dim pvt_dct_ValidColumn As Scripting.Dictionary
          Dim pvt_dct_SkipColumn As Scripting.Dictionary
          Dim pvt_dct_ValidRow As Scripting.Dictionary
          
          Dim pvt_lng_AreaNumber As Long
          Dim pvt_lng_FirstColumn As Long
          Dim pvt_lng_LastColumn As Long
          Dim pvt_lng_RowNumber As Long
          Dim pvt_lng_ColumnNumber As Long
          
          Dim pvt_flg_ValidRow As Boolean
          Dim pvt_var_SkipColumn As Variant
          Dim pvt_int_ColumnElement As Integer
          Dim pvt_int_RowElement As Integer
          Dim pvt_lng_TargetColumn As Long
          Dim pvt_lng_TargetRow As Long
          
     '#
     '# initialise variables - note that the maximum number of columns to be considered is not dependent on the
     '# columns defined in the worksheet, but rather by a limit imposed by the user - i.e. from column "Q" to "HG"
     '#
          Set pvt_xls_Current = ThisWorkbook.ActiveSheet
          Set pvt_dct_ValidRow = New Scripting.Dictionary
          Set pvt_dct_ValidColumn = New Scripting.Dictionary
          Set pvt_dct_SkipColumn = New Scripting.Dictionary
          
          pvt_lng_FirstColumn = Columns("Q").Column
          pvt_lng_LastColumn = Columns("HG").Column
          
     '#
     '# load the dictionary of invalid columns based on the columns that were specified as to be
     '# excluded from the copy process - additional column identifiers can be added to the array
     '# as and when needed
     '#
          For Each pvt_var_SkipColumn In Array("AF", "BF", "CG", "DH", "ES", "FV", "HD", "HF")
               pvt_dct_SkipColumn.Add Columns(pvt_var_SkipColumn).Column, vbNullString
          Next pvt_var_SkipColumn
          
     '#
     '# add the header rows 4 and 5 to the valid row dictionary because they always need to be included
     '# in the copy step - as long as at least one valid data rows has been found in the selection
     '#
          pvt_dct_ValidRow.Add 4, vbNullString
          pvt_dct_ValidRow.Add 5, vbNullString
          
     '#
     '# execute a loop on all rows present in the selection - adjacent selected rows are always in a single
     '# area - but more areas can be present in the selection made by the user
     '#
          With pvt_xls_Current
          
               For pvt_lng_AreaNumber = 1 To Selection.Areas.Count
                    For pvt_lng_RowNumber = Selection.Areas(pvt_lng_AreaNumber).Row To (Selection.Areas(pvt_lng_AreaNumber).Row + Selection.Areas(pvt_lng_AreaNumber).Rows.Count - 1)
                    '#
                    '# loop for all columns from Q to HG, skipping the excluded columns, to determine if a non-blank
                    '# entry exists - when found the column must be added to the valid column dictionary and the
                    '# boolean indicating that the row is valid must be set to True
                    '#
                         pvt_flg_ValidRow = False
                         For pvt_lng_ColumnNumber = pvt_lng_FirstColumn To pvt_lng_LastColumn
                              If Not pvt_dct_SkipColumn.Exists(pvt_lng_ColumnNumber) Then
                                   If LenB(.Cells(pvt_lng_RowNumber, pvt_lng_ColumnNumber).Value) > 0 Then
                                        pvt_flg_ValidRow = True
                                        If Not pvt_dct_ValidColumn.Exists(pvt_lng_ColumnNumber) Then
                                             pvt_dct_ValidColumn.Add pvt_lng_ColumnNumber, "VAL"
                                        End If
                                   End If
                              End If
                         Next pvt_lng_ColumnNumber
                    '#
                    '# if a non-blank cell was encountered for the selected row, the row is considered valid
                    '# and the tow number is added to the valid row dictionary object - if not a message
                    '# is displayed to the user stating that the row is skipped
                    '#
                         If pvt_flg_ValidRow Then
                              pvt_dct_ValidRow.Add pvt_lng_RowNumber, vbNullString
                         Else
                              MsgBox "Row number " & pvt_lng_RowNumber & " is skipped as all cells are empty"
                         End If
                    Next pvt_lng_RowNumber
               Next pvt_lng_AreaNumber
          
          End With
          
     '#
     '# if no valid data rows were encountered during the previous step, the valid row collection
     '# only holds the two entries (i.e. the header rows 4 and 5) - inform the user and exit the routine
     '#
          If pvt_dct_ValidRow.Count = 2 Then
               MsgBox "No valid rows selected, no new workbook created"
               Exit Sub
          End If
          
     '#
     '# the dictionary objects now hold all valid columns and all valid rows that should be included in the
     '# copy workbook - create the new workbook and copy the data
     '#
          Set pvt_wbk_New = Application.Workbooks.Add
          pvt_lng_TargetRow = 0
          
          With pvt_xls_Current
               For pvt_int_RowElement = 0 To (pvt_dct_ValidRow.Count - 1)
                    
                    pvt_lng_RowNumber = pvt_dct_ValidRow.Keys(pvt_int_RowElement)
                    pvt_lng_TargetRow = pvt_lng_TargetRow + 1
                    pvt_lng_TargetColumn = 0
                    
                    For pvt_int_ColumnElement = 0 To (pvt_dct_ValidColumn.Count - 1)
                         pvt_lng_TargetColumn = pvt_lng_TargetColumn + 1
                         pvt_wbk_New.Worksheets("Sheet1").Cells(pvt_lng_TargetRow, pvt_lng_TargetColumn).Value = _
                                   .Cells(pvt_lng_RowNumber, pvt_dct_ValidColumn.Keys(pvt_int_ColumnElement)).Value
                    Next pvt_int_ColumnElement
                    
               Next pvt_int_RowElement
          End With

     '#
     '# set all columns in the new workbook to autofit and activate the new workbook
     '#
          With pvt_wbk_New
               .Worksheets("Sheet1").Cells.Columns.AutoFit
               .Activate
          End With
          
End Sub