LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,836
Default Copy Tab Names from Several Sheets and Copy Last Row from Same

You are correct Rick! The results are exactly the same. You know VBA much,
much, much better than I do, and that's probably why you are an MVP. I want
to thank you for your second Sub. It is certainly more eloquent than the one
I cobbled together from your original code.

Thank you again!!!
Ryan--

--
RyGuy


"Rick Rothstein (MVP - VB)" wrote:

First, I'd like to point out that these two statements, one next to the
other, cancel out and leave SummaryRow exactly the same...

SummaryRow = SummaryRow + 1
SummaryRow = SummaryRow - 1

Second, I **think** this shorter code procedure will do the same thing that
the revised code you posted does...

'*************** START OF CODE ***************
Dim X As Long
Dim SummaryRow As Long
Dim Sht As Worksheet
Dim NewSht As Worksheet

Dim Cols() As String
Cols = Split(",M,N,O,P,T,V,W,AA", ",")

Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Summary").Delete
Application.DisplayAlerts = True

Set NewSht = Worksheets.Add
NewSht.Name = "Summary"
SummaryRow = 3

With NewSht.Range("A1")
For Each Sht In Worksheets
If InStr(1, "*Summary*Summary-Sheet*C2_UnionQuery*", _
"*" & Sht.Name & "*", vbTextCompare) = 0 Then
.Offset(SummaryRow, 0).Value = Sht.Name
For X = 1 To 8
.Offset(SummaryRow, X).Value = Sht.Cells(Rows.Count, _
Cols(X)).End(xlUp).Value
Next
SummaryRow = SummaryRow + 1
End If
Next
End With
'*************** END OF CODE ***************

Rick


"ryguy7272" wrote in message
...
Thanks so much Rick!! Worked exactly as I thought it should. I made a
few
slight modifications to get the bottom values form several different
columns:

Dim X As Long
Dim SummaryRow As Long
Dim Sht As Worksheet
Dim NewSht As Worksheet

Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Summary").Delete
Application.DisplayAlerts = True

Set NewSht = Worksheets.Add
NewSht.Name = "Summary"
SummaryRow = 3


With NewSht.Range("A1")
For Each Sht In Worksheets

If InStr(1, "*Summary*Summary-Sheet*C2_UnionQuery*", _
"*" & Sht.Name & "*", vbTextCompare) = 0 Then
.Offset(SummaryRow, 0).Value = Sht.Name
.Offset(SummaryRow, 1).Value = Sht.Cells(Rows.Count, "M"). _
End(xlUp).Value
SummaryRow = SummaryRow + 1

SummaryRow = SummaryRow - 1
.Offset(SummaryRow, 2).Value = Sht.Cells(Rows.Count, "N"). _
End(xlUp).Value
SummaryRow = SummaryRow + 1

SummaryRow = SummaryRow - 1
.Offset(SummaryRow, 3).Value = Sht.Cells(Rows.Count, "O"). _
End(xlUp).Value
SummaryRow = SummaryRow + 1

SummaryRow = SummaryRow - 1
.Offset(SummaryRow, 4).Value = Sht.Cells(Rows.Count, "P"). _
End(xlUp).Value
SummaryRow = SummaryRow + 1

SummaryRow = SummaryRow - 1
.Offset(SummaryRow, 5).Value = Sht.Cells(Rows.Count, "T"). _
End(xlUp).Value
SummaryRow = SummaryRow + 1

SummaryRow = SummaryRow - 1
.Offset(SummaryRow, 6).Value = Sht.Cells(Rows.Count, "V"). _
End(xlUp).Value
SummaryRow = SummaryRow + 1

SummaryRow = SummaryRow - 1
.Offset(SummaryRow, 7).Value = Sht.Cells(Rows.Count, "W"). _
End(xlUp).Value
SummaryRow = SummaryRow + 1

SummaryRow = SummaryRow - 1
.Offset(SummaryRow, 8).Value = Sht.Cells(Rows.Count, "AA"). _
End(xlUp).Value
SummaryRow = SummaryRow + 1

End If
Next
End With


Thanks again!
Ryan---

--
RyGuy


"Rick Rothstein (MVP - VB)" wrote:

Does this code do what you are trying to do?

Sub Summary()
Dim X As Long
Dim SummaryRow As Long
Dim Sht As Worksheet
Dim NewSht As Worksheet

Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Summary").Delete
Application.DisplayAlerts = True

Set NewSht = Worksheets.Add
NewSht.Name = "Summary"

With NewSht.Range("A1")
For Each Sht In Worksheets
If InStr(1, "*Summary*Summary-Sheet*C2_UnionQuery*", _
"*" & Sht.Name & "*", vbTextCompare) = 0 Then
.Offset(SummaryRow, 0).Value = Sht.Name
.Offset(SummaryRow, 1).Value = Sht.Cells(Rows.Count, "A"). _
End(xlUp).Value
SummaryRow = SummaryRow + 1
End If
Next
End With
End Sub


Rick


"ryguy7272" wrote in message
...
I am stuck on something that shouldn't be too hard...but seems hard
right
now. I am working on a macro that lists all sheets in my workbook,
except
for three specific sheets, and then I wanted to list the last user row
on
each sheet, so that it corresponds with each name in the list (the
names
come
from the tabs in the workbook). This is what I have so far:

Sub SummarySht()

Application.DisplayAlerts = False
Dim sht As Worksheet
Dim I As Long
Dim bWrite As Boolean

Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("Summary").Delete
On Error GoTo 0
Application.DisplayAlerts = True

Set Basebook = ThisWorkbook
Set Newsht = Basebook.Worksheets.Add
Newsht.Name = "Summary"

Sheets("Summary").Select

n = Worksheets.Count
For I = 1 To n
sht = Worksheets(I).Name
If sht = "Summary" Or sht = "C2_UnionQuery" Or sht =
"Summary-Sheet"
Then
Else
ActiveCell.Value = Sheets("Summary").Range("A3")
ActiveCell.Offset(1, 0).Select
End If
Next

End Sub

The macro fails on this line:
sht = Worksheets(I).Name

The message that I get is €˜Object Variable with Block Variable not Set.
The code looks right to me, so Im not sure why its saying this.

Also, I am still working on a way of copying the last used row from
each
sheet in the book, except for "Summary", "C2_UnionQuery", and
"Summary-Sheet".

I think the 'last used row' part will be something like this:
Dim LastRow As Long
Dim sht As Worksheet

For Each sht In Worksheets
If (sht.Name) < "Summary" and (sht.Name) < "C2_UnionQuery" And
(sh.Name) < "Summary-Sheet" Then
sht.Activate



Chng = Range("A6").Value
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(LastRow, "A").Activate
sh.Cells(Rows.Count, "A").End(xlUp).EntireRow.Copy = True

Sheets("Summary").Activate
ActiveCell.Value = Sheets("Summary").Range("A3")
ActiveCell.Offset(2, 1).Select
ActiveCell.Paste

Next sht

...but it is not quite right. The last row on each of the sheets
should
correspond to the names (from the tabs) listed in the 'Summary' sheet.
Can
someone please give me some assistance?

Thanks,
Ryan---

--
RyGuy

--
RyGuy




 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Match Names in columns then copy associated info from 2 sheets Seantastic Excel Worksheet Functions 4 October 29th 08 08:29 PM
move or copy sheets doesn't copy format ColinX Excel Worksheet Functions 1 May 14th 08 10:07 PM
how to copy workbook names and worksheet names to columns in acces gokop Excel Programming 4 August 27th 07 11:26 AM
in VBA Sheets("mysheet").Copy Befo=Sheets(1) how do i get a reference to the newly created copy of this sheet? Daniel Excel Worksheet Functions 1 July 6th 05 09:57 PM
copy sheet1 and name sheets using names from a range DL[_3_] Excel Programming 2 September 2nd 03 12:58 PM


All times are GMT +1. The time now is 10:33 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"