Merging Multiple Worksheet Data to one (with specifics)

[syke27]

Hi all,

Though there are many posts here regarding this subject, I've been reading through them for about 3 hours and trying our different macro codes. I can't find one that does what I need and I'm not sure how to adjust existing macros to get what I want. I'll post my problem and specific needs and then the macro script I've found that works best (but takes much longer than it should) to see if anyone is able to shorten it in order to improve the processing time. Thanks in advance!!!!! This is my first time posting so bare with me. I'll try to be as succinct as possible while keeping this SOMEWHAT short!

Request:
Merge data from multiple worksheets to one worksheet via macro in order to have a complete list of the most recently saved information.

Scenario:
The workbook will have one worksheet for each of 7 or 8 buyers (employees). The column headers will be consistent across each of those tabs but the # of rows of data will change by employee and will grow over time. The data on those sheets includes about 14 columns with "style", "Size", "Color", "Cost from Manufacturer", "Freight", "retail price", etc. The buyers will be updating the most recent cost information as they negotiate it and saving it in this shared workbook.

I'd like to create a tab with a macro button that allows a superior to pull all style data from the tabs to one page with one column header (the same as in the worksheets of course), that he/she can then use for different reports as he/she chooses.

Specifics:

• There will be 1 row of column headers that is consistent across all worksheets (including "merged" worksheet). I'd like it to pull the header row just once if possible. If not, I'd like to list the header rows on the new sheet and just make them fixed, so only the row data refreshes each time.
• I don't want the macro to create a new tab in the process but rather overwrite the data on X tab (I'll call it "Master") whenever needed. So the supervisor can open the file when they need the most up to date cost info, hit the macro button, then take the data (perhaps via copy/paste) and use it as they'd like. Some macro's I've found create a new tab each time, which won't work for this scenario.
• I don't want to have to select "active" sheets before running the macro. I'd just like it to know to pull certain tabs. Each tab will have a buyer name most likely and there will be 7 or 8 of them. For the example let's do 8.
• I don't want it to pull in blank rows, just rows with data from the first tab then rows from the second (and so on) in the next row so ultimately there's one sheet of 1,500 or so lines of data on one tab.

Example:
I found this example on another post and it works pretty well, however it drags. The user also posted a shorter version, but it doesn't include some of the specifics above. Can this be shortened to accommodate the request? Also, I understand the macro below will stop at row 100. I can update that though to 1000 to suit my needs!

Sub MergeSheets()
Const sRANGE = "A1:Z100"
Dim iSheet, iTargetRow As Long, oCell As Object, bRowWasNotBlank As Boolean
Dim iTop, iLeft, iBottom, iRight As Long
'Sheets(1).Select: Sheets.Add
Sheets(1).Select
Cells.Select
Selection.Clear
bRowWasNotBlank = True
For iSheet = 2 To ThisWorkbook.Sheets.Count: DoEvents
For Each oCell In Sheets(iSheet).Range (sRANGE).Cells: DoEvents
If oCell.Column = 1 Then
If bRowWasNotBlank Then iTargetRow = iTargetRow + 1
bRowWasNotBlank = False
End If
If oCell.MergeCells Then
bRowWasNotBlank = True
If oCell.MergeArea.Cells(1).Row = oCell.Row Then
If oCell.MergeArea.Cells (1).Column = oCell.Column Then
Sheets(1).Cells(iTargetRow, oCell.Column) = oCell
iTop = iTargetRow
iLeft = oCell.Column
iBottom = iTop + oCell.MergeArea.Rows.Count - 1
iRight = iLeft + oCell.MergeArea.Columns.Count - 1
Sheets(1).Range(Cells(iTop, iLeft), Cells(iBottom, iRight)).MergeCells = True
End If
End If
End If
If Len(oCell) Then bRowWasNotBlank = True
Sheets(1).Cells(iTargetRow, oCell.Column) = oCell
Next oCell
Next
Sheets(1).Activate
End Sub

 

[syke27]

Actually, this works as well, but it copies blank lines:

Sub MergeSheets2()
Const sRANGE = "A1:Z100"
Dim iSheet, iTargetRow As Long, oCell As Object
Dim iTop, iLeft, iBottom, iRight As Long
'Sheets(1).Select: Sheets.Add
Sheets(1).Select
Cells.Select
Selection.Clear
iTargetRow = 1
For iSheet = 2 To ThisWorkbook.Sheets.Count: DoEvents
Sheets(iSheet).Select
Range(sRANGE).Select
Selection.Copy
Sheets(1).Select
Cells(iTargetRow, 1).Select
ActiveSheet.Paste
iTargetRow = iTargetRow + Range(sRANGE).Rows.Count
Next
End Sub

I've read that I can sub in:

If bRowWasNotBlank Then iTargetRow = iTargetRow + 1] to [iTargetRow = iTargetRow + 1

Somewhere to remove those blank lines? Does it just replace "iTargetRow = iTargetRow + Range(sRANGE).Rows.Count" toward the bottom of the formula above?

 

[syke27]

Hmmm... doing that made the macro only pull over the data from the first sheet vs. the others. I think I'm missing something?