Summary sheet in a workbook

AGnes · 06-08-2005, 11:05 AM

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 · 06-08-2005, 11:05 AM

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" <[email protected]> wrote in message
news:[email protected]...
>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 · 06-08-2005, 11:05 AM

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" <[email protected]> wrote in message news:[email protected]...
> 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" <[email protected]> wrote in message news:[email protected]...
>>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 · 06-08-2005, 01:05 PM

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 · 06-08-2005, 01:05 PM

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" <[email protected]> wrote in message news:[email protected]...
> 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 · 06-10-2005, 05:05 PM

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" <[email protected]> wrote in message news:[email protected]...
> > 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 · 06-10-2005, 06:05 PM

You can test if the lastrow >6 in the code

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

"AGnes" <[email protected]> wrote in message news:[email protected]...
> 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" <[email protected]> wrote in message news:[email protected]...
>> > 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 · 06-10-2005, 07:05 PM

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" <[email protected]> wrote in message news:[email protected]...
> > 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" <[email protected]> wrote in message news:[email protected]...
> >> > 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
> >> >>
> >> >>
> >> >>
> >> >>
> >> >>
> >>
> >>
> >>
>
>
>