-1

I'm looking to automate the selective copying and stacking of data from multiple sheets into a single sheet. More specifically, I have 4 columns (M, H, A, & F) from which I need to selectively copy cells based on the same-row value of Column I. E.g. with the below case:

Worksheets 2...N  
Column A_____Column F_____Column H_____Column I_____Column M  
_#####________AAAAAA______AAAAAA_______Rqrmnt_______Date
_#####________AAAAAA______AAAAAA_______Heading_______Blank

For all rows with column I = Rqrmnt across N worksheets, I need to copy the corresponding values in columns A, F, H, and M into worksheet 1, stacking the imports of each sheet top-to-bottom, e.g.:

Worksheet 2 Column A...Worksheet 2 Column M  
Worksheet 3 Column A...Worksheet 3 Column M  
... 
Worksheet N Column A...Worksheet N Column M  

I need to be able to perform limited manipulation on the resulting table, specifically sorting the rows by the value of Column M

As I have several hundred such entries, I would prefer to not build this up by linking cells 1-by-1. Additionally, I would prefer to place the copied pseudo-columns individually (i.e. rearrange them in the order M>H>A>F on the master spreadsheet). I Have the following macro, derived from these posts (thanks to urdearboy's comment below for the second linked post). However, I get a Run-time Error 91 fault when I try to run the macro, and the debugger highlights the identified line below. While this post explains the error itself, I has not helped me solve this problem. I have tried initializing the sourceSheetLastRow to an arbitrary number, and slapping the Set keyword in front of the formula, but to no avail.

Option Explicit

Sub Test()

    Dim summarySheetTargetRow As Long
    Dim sourceSheetTargetRow As Long
    Dim sourceSheetLastRow As Long
    Dim sourceSheetIndex As Long
    Dim numSheets As Long
    Dim wb As Workbook
    Dim summarySheet As Worksheet
    Dim sourceSheet As Worksheet

    Set wb = ThisWorkbook
    Set summarySheet = wb.Sheets("Summary Sheet")

    numSheets = ThisWorkbook.Sheets.Count  `My understanding is that this will return the total number of worksheets in the workbook. However, the sheet index seems to skip the number 5, so this may not be getting me the actual number of sheets
    sourceSheetIndex = 6                   `First sheet from which I want to pull values. Note that the sheets have inconsistent names, so I'm trying to use the sheet index.
    summarySheetTargetRow = 38             `Where I want to start plugging in copied cell values
    `Make sure receiving area for copied info is clear
    Sheets("Summary Sheet").Range("A38:D1415").ClearContents


    For sourceSheetIndex = 6 To numSheets
        Set sourceSheet = wb.Worksheets(sourceSheetIndex)

        DEBUG THORWS FAULT HERE[
        sourceSheetLastRow = sourceSheet.Range("M2:M1000").Find("*", SearchDirection:=xlPrevious).Row `I understand this to return the number of cells in the specified range, starting from the last non-empty cell.
        ]DEBUG THORWS FAULT HERE

        For sourceSheetTargetRow = 2 To sourceSheetLastRow `Start at second row because header rows will never have relevant value
            If sourceSheet.Range("I" & sourceSheetTargetRow) = "Text" Then
                summarySheet.Range("A" & summarySheetTargetRow) = sourceSheet.Range("A" & sourceSheetTargetRow)
                summarySheet.Range("B" & summarySheetTargetRow) = sourceSheet.Range("M" & sourceSheetTargetRow)
                summarySheet.Range("C" & summarySheetTargetRow) = sourceSheet.Range("H" & sourceSheetTargetRow)
                summarySheet.Range("D" & summarySheetTargetRow) = sourceSheet.Range("F" & sourceSheetTargetRow)
                summarySheetTargetRow = summarySheetTargetRow + 1
            End If
        Next sourceSheetTargetRow
    Next sourceSheetIndex

End Sub
SysEng91
  • 1
  • 3
  • What is the `ii = 192` here? Has this been modified at all for your needs? Parts of this seem clear. Change the ranges that are being set to the columns you care about. In above code, the values in columns D, O, K, & M are being replaced by columns from X, Z, AB, AD (respectively) from a second sheet. It seems at minimum, that could be figured out? – urdearboy Oct 09 '19 at 21:15
  • I have not tried modifying it to my needs yet. While I can, yes, probably tweak the column ranges, row ranges, and IF statement conditions in the For loop, I do not have sufficient VBA proficiency to know how to get the macro running across more than one reference sheet. – SysEng91 Oct 09 '19 at 22:23
  • How to do that is well documented here ([see posts like this](https://stackoverflow.com/questions/25953916/excel-vba-looping-through-multiple-worksheets)). At the very least, you should update what you can and do research before posting – urdearboy Oct 09 '19 at 23:15
  • I had done research prior to posting. The referenced code snippet is a direct result of that research. Having already been beating my head against this task for about a day and a half I had been thinking of reaching a direct resolution. That said, I thank you for providing additional information, and will endeavor to further decompose my objective in future queries so as to acquire more applicable results. – SysEng91 Oct 09 '19 at 23:39

2 Answers2

0

When do you copy cells, what conditionals in column I need to be true/false? You could use Union to select multiple rows of cells at once.

Ross Symonds
  • 690
  • 1
  • 8
  • 29
0

Courtesy of help I get from my own company's e-forums and a good bit more work, I have finally gotten my desired output. The below macro will copy data from the identified ranges into a semi-dynamic range in a "Summary Sheet". It requires some knowledge of how the source sheet(s) will be formatted.

Option Explicit

Sub Data_Rollup()
    'Object variables, which need to be released from memory at the end.
    Dim wb As Workbook
    Dim summarySheet As Worksheet
    Dim sourceSheet As Worksheet

    'Non-object variables
    Dim summarySheetTargetRow As Long
    Dim sourceSheetTargetRow As Long
    Dim sourceSheetLastRow As Long
    Dim sourceSheetIndex As Long
    Dim numSheets As Long

    On Error GoTo Error_Test 'Escape clause

    'Initialize objects
    Set wb = ThisWorkbook
    Set summarySheet = wb.Sheets("Summary Sheet")

    'Initialize non-object variables
    sourceSheetIndex = 5                                        'Hard-coded starting point for data pull. This should be greater than the number for the Summary sheet.
    summarySheetTargetRow = 38                                  'Hard-coded starting point for data deposition
    numSheets = wb.Sheets.Count                                 'returns the number of sheets in workbook "wb"
    Sheets("Summary Sheet").Range("A38:D1415").ClearContents    'Clears out destination cells in summary sheet

    'Main loop
    For sourceSheetIndex = 5 to numSheets
        Set sourceSheet = wb.Worksheets(sourceSheetIndex)
        If Not (sourceSheet.Range("A2:A1000").Find("*", SearchDirection:=xlPrevious) Is Nothing) Then 'Using *If Not (* Is Empty) Then* ensures the code just skips over sheets that don't have the range A2:A1000 populated 
            sourceSheetLastRow = sourceSheet.Range("A2:A1000").Find("*", SearchDirection:=xlPrevious).Row 'searches through the defined range from the bottom up, and returns the number of the first populated row
            For sourceSheetTargetRow = 2 To sourceSheetLastRow 'Start at second row to skip headers
                If sourceSheet.Range("I" & sourceSheetTargetRow) = "Text" Then
                    summarySheet.Range("A" & summarySheetTargetRow) = sourceSheet.Range("A" & sourceSheetTargetRow)
                    summarySheet.Range("B" & summarySheetTargetRow) = sourceSheet.Range("M" & sourceSheetTargetRow)
                    summarySheet.Range("C" & summarySheetTargetRow) = sourceSheet.Range("H" & sourceSheetTargetRow)
                    summarySheet.Range("D" & summarySheetTargetRow) = sourceSheet.Range("F" & sourceSheetTargetRow)
                    summarySheetTargetRow = summarySheetTargetRow + 1
                End If 'best practise is to always have an Else clause, but it isn't technically necessary
            Next sourceSheetTargetRow 'Cycles loop to next row down
        End If 'best practise is to always have an Else clause, but it isn't technically necessary
    Next sourceSheetIndex 'Cycles loop to next worksheet

Exit_Test: 'Deallocates memory for object variables
    Set sourceSheet = Nothing
    Set summarySheet = Nothing
    Set wb = Nothing
    Exit Sub
Error_Test
    MsgBox Err.Number & "-" & Err.Description
    GoTo Exit_Test

End Sub
SysEng91
  • 1
  • 3