ExcelBanter - Summary sheet in a workbook

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Summary sheet in a workbook (https://www.excelbanter.com/excel-programming/331187-summary-sheet-workbook.html)

AGnes

Summary sheet in a workbook

I have the following macro that helps me copy a range of data (from row 10 to
the last row) from each worksheet in a workbook and paste it onto a new
worksheet called "upload". This macro works when I installed it to a
workbook, but doesn't work when I installed it to personal.xls. I do want to
use this on all incoming workbooks from other department. I'd appreciate if
you can help me modify it. Thanks in advance!

--Agnes

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

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Upload").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Upload"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

sh.Range(sh.Rows(10), sh.Rows(shLast)).Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
End With

End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The upload sheet already exist"
End If
End Sub

Norman Jones

Summary sheet in a workbook

Hi Agnes,

To run the code from your Personal.xls on any active workbbook, change each
of the 3 instances of :

ThisWorkBook

to

ActiveWorkbook

---
Regards,
Norman

"AGnes" wrote in message
...
I have the following macro that helps me copy a range of data (from row 10
to
the last row) from each worksheet in a workbook and paste it onto a new
worksheet called "upload". This macro works when I installed it to a
workbook, but doesn't work when I installed it to personal.xls. I do want
to
use this on all incoming workbooks from other department. I'd appreciate
if
you can help me modify it. Thanks in advance!

--Agnes

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

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Upload").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Upload"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

sh.Range(sh.Rows(10), sh.Rows(shLast)).Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
End With

End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The upload sheet already exist"
End If
End Sub

Ron de Bruin

Summary sheet in a workbook

Hi Norman

I believe I must add a note on my site about this <g

--
Regards Ron de Bruin
http://www.rondebruin.nl

"Norman Jones" wrote in message ...
Hi Agnes,

To run the code from your Personal.xls on any active workbbook, change each of the 3 instances of :

ThisWorkBook

to

ActiveWorkbook

---
Regards,
Norman

"AGnes" wrote in message ...
I have the following macro that helps me copy a range of data (from row 10 to
the last row) from each worksheet in a workbook and paste it onto a new
worksheet called "upload". This macro works when I installed it to a
workbook, but doesn't work when I installed it to personal.xls. I do want to
use this on all incoming workbooks from other department. I'd appreciate if
you can help me modify it. Thanks in advance!

--Agnes

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

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Upload").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Upload"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

sh.Range(sh.Rows(10), sh.Rows(shLast)).Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
End With

End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The upload sheet already exist"
End If
End Sub

AGnes

Summary sheet in a workbook

Thank you all for your help. I am new to VBA so thanks for excusing me for
not even knowing the basic of it!

"AGnes" wrote:

I have the following macro that helps me copy a range of data (from row 10 to
the last row) from each worksheet in a workbook and paste it onto a new
worksheet called "upload". This macro works when I installed it to a
workbook, but doesn't work when I installed it to personal.xls. I do want to
use this on all incoming workbooks from other department. I'd appreciate if
you can help me modify it. Thanks in advance!

--Agnes

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

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Upload").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Upload"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

sh.Range(sh.Rows(10), sh.Rows(shLast)).Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
End With

End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The upload sheet already exist"
End If
End Sub

Ron de Bruin

Summary sheet in a workbook

Hi AGnes

I am new to VBA so thanks for excusing me for
not even knowing the basic of it!

No problem

BTW :: It is there already (I forgot I add it)
http://www.rondebruin.nl/copy2.htm

Note : if you want to use the code in your personal.xls you must change
every ThisWorkbook to ActiveWorkbook in the code.

Maybe you want to read this site
http://www.mvps.org/dmcritchie/excel/getstarted.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl

"AGnes" wrote in message ...
Thank you all for your help. I am new to VBA so thanks for excusing me for
not even knowing the basic of it!

"AGnes" wrote:

I have the following macro that helps me copy a range of data (from row 10 to
the last row) from each worksheet in a workbook and paste it onto a new
worksheet called "upload". This macro works when I installed it to a
workbook, but doesn't work when I installed it to personal.xls. I do want to
use this on all incoming workbooks from other department. I'd appreciate if
you can help me modify it. Thanks in advance!

--Agnes

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

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Upload").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Upload"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

sh.Range(sh.Rows(10), sh.Rows(shLast)).Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
End With

End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The upload sheet already exist"
End If
End Sub

AGnes

Summary sheet in a workbook

But I have a problem...if the workbook contains a blank sheet, the macro
doesn't work and it stops at

sh.Range(sh.Rows(6), sh.Rows(shLast)).Copy

I guess since there is no contend on a blank sheet, it can't identify the
last row.

Any solution to that? Thanks a lot in advance.

--Agnes

"Ron de Bruin" wrote:

Hi AGnes

I am new to VBA so thanks for excusing me for
not even knowing the basic of it!

No problem

BTW :: It is there already (I forgot I add it)
http://www.rondebruin.nl/copy2.htm

Note : if you want to use the code in your personal.xls you must change
every ThisWorkbook to ActiveWorkbook in the code.

Maybe you want to read this site
http://www.mvps.org/dmcritchie/excel/getstarted.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl

"AGnes" wrote in message ...
Thank you all for your help. I am new to VBA so thanks for excusing me for
not even knowing the basic of it!

"AGnes" wrote:

I have the following macro that helps me copy a range of data (from row 10 to
the last row) from each worksheet in a workbook and paste it onto a new
worksheet called "upload". This macro works when I installed it to a
workbook, but doesn't work when I installed it to personal.xls. I do want to
use this on all incoming workbooks from other department. I'd appreciate if
you can help me modify it. Thanks in advance!

--Agnes

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

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Upload").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Upload"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

sh.Range(sh.Rows(10), sh.Rows(shLast)).Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
End With

End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The upload sheet already exist"
End If
End Sub

Ron de Bruin

Summary sheet in a workbook

You can test if the lastrow 6 in the code

--
Regards Ron de Bruin
http://www.rondebruin.nl

"AGnes" wrote in message ...
But I have a problem...if the workbook contains a blank sheet, the macro
doesn't work and it stops at

sh.Range(sh.Rows(6), sh.Rows(shLast)).Copy

I guess since there is no contend on a blank sheet, it can't identify the
last row.

Any solution to that? Thanks a lot in advance.

--Agnes

"Ron de Bruin" wrote:

Hi AGnes

I am new to VBA so thanks for excusing me for
not even knowing the basic of it!

No problem

BTW :: It is there already (I forgot I add it)
http://www.rondebruin.nl/copy2.htm

Note : if you want to use the code in your personal.xls you must change
every ThisWorkbook to ActiveWorkbook in the code.

Maybe you want to read this site
http://www.mvps.org/dmcritchie/excel/getstarted.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl

"AGnes" wrote in message ...
Thank you all for your help. I am new to VBA so thanks for excusing me for
not even knowing the basic of it!

"AGnes" wrote:

I have the following macro that helps me copy a range of data (from row 10 to
the last row) from each worksheet in a workbook and paste it onto a new
worksheet called "upload". This macro works when I installed it to a
workbook, but doesn't work when I installed it to personal.xls. I do want to
use this on all incoming workbooks from other department. I'd appreciate if
you can help me modify it. Thanks in advance!

--Agnes

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

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Upload").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Upload"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

sh.Range(sh.Rows(10), sh.Rows(shLast)).Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
End With

End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The upload sheet already exist"
End If
End Sub

AGnes

Summary sheet in a workbook

It does. Thanks a million!

-Agnes

"Ron de Bruin" wrote:

You can test if the lastrow 6 in the code

--
Regards Ron de Bruin
http://www.rondebruin.nl

"AGnes" wrote in message ...
But I have a problem...if the workbook contains a blank sheet, the macro
doesn't work and it stops at

sh.Range(sh.Rows(6), sh.Rows(shLast)).Copy

I guess since there is no contend on a blank sheet, it can't identify the
last row.

Any solution to that? Thanks a lot in advance.

--Agnes

"Ron de Bruin" wrote:

Hi AGnes

I am new to VBA so thanks for excusing me for
not even knowing the basic of it!

No problem

BTW :: It is there already (I forgot I add it)
http://www.rondebruin.nl/copy2.htm

Note : if you want to use the code in your personal.xls you must change
every ThisWorkbook to ActiveWorkbook in the code.

Maybe you want to read this site
http://www.mvps.org/dmcritchie/excel/getstarted.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl

"AGnes" wrote in message ...
Thank you all for your help. I am new to VBA so thanks for excusing me for
not even knowing the basic of it!

"AGnes" wrote:

I have the following macro that helps me copy a range of data (from row 10 to
the last row) from each worksheet in a workbook and paste it onto a new
worksheet called "upload". This macro works when I installed it to a
workbook, but doesn't work when I installed it to personal.xls. I do want to
use this on all incoming workbooks from other department. I'd appreciate if
you can help me modify it. Thanks in advance!

--Agnes

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

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Upload").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Upload"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

sh.Range(sh.Rows(10), sh.Rows(shLast)).Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
End With

End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The upload sheet already exist"
End If
End Sub

All times are GMT +1. The time now is 12:30 PM.