G
Guest
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
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