macro error - copying data twice
 

I have the following macro (created with this board's help!) that works well,
except it copies each sheet's data to the master twice. Can anyone tell me
what to change so that it only copies the data from each sheet once?

Many thanks!
Gretta

Sub Test5()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long

' copies each sheets contents to master sheet

On Error Resume Next
If Len(ActiveWorkbook.Worksheets.Item("Master").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Master"
For Each sh In ActiveWorkbook.Worksheets
If Not IsError(Application.Match(sh.Name,
Worksheets("MySheets").Range(Worksheets _
("MySheets").Cells(1, "A"),
Worksheets("MySheets").Cells(Rows.Count, _
"A").End(xlUp)), 0)) Then
Last = LastRow(DestSh)
shLast = LastRow(sh)
sh.Range(sh.Rows(6), sh.Rows(shLast)).Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
.PasteSpecial 8, , False, False
Application.CutCopyMode = False
End With
End If
Next
DestSh.Cells(1).Select
Sheets("Accounting").Select
Rows("5:5").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Master").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub

macro error - copying data twice
 

I'd guess it was related to your two paste special lines. Why don't you step
through the macro line by line and see where it happens.

"Gretta" wrote:

I have the following macro (created with this board's help!) that works well,
except it copies each sheet's data to the master twice. Can anyone tell me
what to change so that it only copies the data from each sheet once?

Many thanks!
Gretta

Sub Test5()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long

' copies each sheets contents to master sheet

On Error Resume Next
If Len(ActiveWorkbook.Worksheets.Item("Master").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Master"
For Each sh In ActiveWorkbook.Worksheets
If Not IsError(Application.Match(sh.Name,
Worksheets("MySheets").Range(Worksheets _
("MySheets").Cells(1, "A"),
Worksheets("MySheets").Cells(Rows.Count, _
"A").End(xlUp)), 0)) Then
Last = LastRow(DestSh)
shLast = LastRow(sh)
sh.Range(sh.Rows(6), sh.Rows(shLast)).Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
.PasteSpecial 8, , False, False
Application.CutCopyMode = False
End With
End If
Next
DestSh.Cells(1).Select
Sheets("Accounting").Select
Rows("5:5").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Master").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub