Macro is over-writing instead of pasting at the bottom of the active sheet

[syke27]

Hi,

I've been working on creating a macro to merge data from multiple worksheets to a "master" and found a script that works but rather than putting each sheet's data at the end of the previous it's overwriting it. Does anyone know how to fix this script so it puts the data at the end of the active worksheet?

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
If bRowWasNotBlank Then iTargetRow = iTargetRow + 1
bRowWasNotBlank = False
Next
End Sub

 

[syke27]

Does anyone have any idea how to fix this?

 

[pcc]

maybe this (try it on a copy of your data first - not tested)

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 + 100  ' increment by 100 as your range is 100 rows

Next
End Sub

 

[syke27]

Thank you so much for replying! Sadly, it didn't work. I found this as well on another site but it requires manually selecting the active sheets you want to merge from. I've been trying to copy/paste peices together to get it to work but no luck yet. Driving me crazy!!

Sub MergeSheets()
' Merges data from all the selected worksheets onto the end of the
' active worksheet.
Const NHR = 1 'Number of header rows to not copy from each MWS

Dim MWS As Worksheet 'Worksheet to be merged
Dim AWS As Worksheet 'Worksheet to which the data are transferred
Dim FAR As Long 'First available row on AWS
Dim LR As Long 'Last row on the MWS sheets

Set AWS = ActiveSheet

For Each MWS In ActiveWindow.SelectedSheets
If Not MWS Is AWS Then
FAR = AWS.UsedRange.Cells(AWS.UsedRange.Cells.Count).Row + 1
LR = MWS.UsedRange.Cells(MWS.UsedRange.Cells.Count).Row
MWS.Range(MWS.Rows(NHR + 1), MWS.Rows(LR)).Copy AWS.Rows(FAR)
End If
Next MWS
End Sub


Which DOES drop it at the bottom but

 

[syke27]

Sorry - that was barely English. That second macro is another I've found/crafted that does what I need only it makes me select active sheets and instead I'd like it to just know to pull sheets titled A, B , C, etc. Maybe it's easier to alter this one than the first I pasted?