Perhaps it needs this tweak

Dim sh As Worksheet
Dim wb As Workbook
Dim this As Workbook

Set this = ActiveWorkbook
Set wb = Workbooks.Add
For Each sh In this.Worksheets

i = i + 1
If i < this.Worksheets.Count Then

this.Worksheets(i).Range("M6").Copy
wb.Worksheets(1).Cells(i, 1).PasteSpecial Paste:=xlValues
End If
Next


--
__________________________________
HTH

Bob

"Bob Phillips" wrote in message
...
Dim sh As Worksheet
Dim wb As Workbook

Set wb = Workbooks.Add
For Each sh In ActiveWorkbook.Worksheets

i = i + 1
If i < ActiveWorkbook.Worksheets.Count Then

Worksheets(i).Range("M6").Copy
wb.Worksheets(1).Cells(i, 1).PasteSpecial Paste:=xlValues
End If
Next


--
__________________________________
HTH

Bob

"carla 7" wrote in message
...
Thanks Jarek. This last macro: Sub kopiuj()

For Each Worksheet In ActiveWorkbook.Worksheets
i = i + 1
If i < ActiveWorkbook.Worksheets.Count Then
Worksheets(i).Range("M6").Copy
Worksheets(ActiveWorkbook.Worksheets.Count).Cells( i, 1).PasteSpecial
Paste=xlValues
End If
Next

End Sub

is a saver. Notice I removed the colon for it to work. Can this macro be
tweaked further to paste values to a new workbook instead of a worksheet.
Just asking.