Macro to merge two sheets

K

kay

Hi
I want to create reports using pivot table.
I have two excel sheets which has data linked with sharepoint list.
I run the macro to synchronize list when i open the file.
Now i want to merge this two sheets and then create mastersheet which has
data from this two sheets. header is same in both the sheets.
and after i have data in mastersheet i want to create pivot tables to
generate reports.
here is the short desc of the process :
Steps of process : when i open the file -
1. it will run macro to synchronize two sheets.
2. then it will run macro to merge two sheets.
3. then it will refresh pivottable (i will create when first time i have
data in master sheet) with latest data from mastersheet.

Here is the code to merge all sheets. but my problem is i dont want to merge
all sheets i just want to merge sheet1 and sheet2. because other sheet has
other reports , pivot table and so .

Thanks for any help!

here is the code:
Sub mergesheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "aMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("aMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "aMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "aMergeSheet"


'Fill in the start row
StartRow = 1

'loop through all worksheets and copy the data to the DestSh

For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> DestSh.Name Then

'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)

'If sh is not empty and if the last row >= StartRow copy the
CopyRng
If shLast > 0 And shLast >= StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to
copy the
'values or want to copy everything look below example 1 on
this page
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If


Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub

------------
 
J

Joel

SheetNames = Array("Sheet1","Sheet2"
for each ShtName in SheetNames
set sht = ActiveWorkbook.Worksheets(ShtName)

next shtname
 
G

Gord Dibben

For Each sh In ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2"))


Gord Dibben MS Excel MVP
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top