syke27
03-09-2011, 10:32 AM
Hi all,
I've been working on a macro for almost a day now (!) that I just can't get right. I've cobbled together two different macros but each is missing a component that I THINK is an easy fix that I just don't know how to write! I'll post them separately, but I'm also open to other macros that will solve for my issue if you have any to suggest!
Requirements:
1. Merging Data from multiple sheets to one. I don't want to select these sheets as active. I'd just like the macro to know which sheets to pull from. There will be 7 sheets to start merging to 1 "Master".
2. I'd like to maintain Master Row A for headers, so the macro should start pasting from the first sheet in Row B.
3. Each sheet's data should paste at the bottom of the previous data on Master. Some of the macros I've tried writing are overwriting each sheet's data leaving me with just the final sheet's data in Master.
4. Don't paste blank rows from the sheets - just data. There will be no blank rows between data so it should just know to stop at the first blank row and move to the next sheet.
This first one works perfectly except:
1. It takes FOREVER to run and I think some stuff could likely be cut out.
2. I'd like to retain the first row for headers but the macro currently starts pasting in RowA. Can it be altered to start pasting in RowB?
Macro:
Sub MergeSheets()
Const sRANGE = "A2: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
I've been working on a macro for almost a day now (!) that I just can't get right. I've cobbled together two different macros but each is missing a component that I THINK is an easy fix that I just don't know how to write! I'll post them separately, but I'm also open to other macros that will solve for my issue if you have any to suggest!
Requirements:
1. Merging Data from multiple sheets to one. I don't want to select these sheets as active. I'd just like the macro to know which sheets to pull from. There will be 7 sheets to start merging to 1 "Master".
2. I'd like to maintain Master Row A for headers, so the macro should start pasting from the first sheet in Row B.
3. Each sheet's data should paste at the bottom of the previous data on Master. Some of the macros I've tried writing are overwriting each sheet's data leaving me with just the final sheet's data in Master.
4. Don't paste blank rows from the sheets - just data. There will be no blank rows between data so it should just know to stop at the first blank row and move to the next sheet.
This first one works perfectly except:
1. It takes FOREVER to run and I think some stuff could likely be cut out.
2. I'd like to retain the first row for headers but the macro currently starts pasting in RowA. Can it be altered to start pasting in RowB?
Macro:
Sub MergeSheets()
Const sRANGE = "A2: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