Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Tab Names from Several Sheets and Copy Last Row from Same She
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Tab Names from Several Sheets and Copy Last Row from Same She
I got the first part working; the sheet tab names now list in Column A. I
just need to copy/paste the last row from each sheet not named "Summary", or "C2_UnionQuery", or "Summary-Sheet" in the cells that correspond to the names, starting in Column B. I think it is something like the below, but that isn't working for me... Sub CopyFromSheets(ByVal strCol As String, _ ByVal strWhat As String, ByVal strPasteCol As String) Dim wks As Worksheet Dim rngFound As Range Dim rngPaste As Range Set rngPaste = Sheets("Summary").Cells(Rows.Count, _ strPasteCol).End(xlUp).Offset(1, 0) For Each wks In Worksheets On Error Resume Next Set rngFound = FindStuff(wks.Columns(strCol), strWhat) On Error GoTo 0 If Not rngFound Is Nothing Then rngFound.Offset(0, 1).Copy rngPaste Set rngFound = Nothing End If Set rngPaste = rngPaste.Offset(1, 0) Next wks End Sub Any thoughts??? -- RyGuy "ryguy7272" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Tab Names from Several Sheets and Copy Last Row from Same She
These lines:
Dim sht As Worksheet .... sht = Worksheets(I).Name are a problem. Since sht is declared as a worksheet, you'd want to use: Dim sht As Worksheet .... set sht = Worksheets(I) And instead of using if/and, I like this: select case lcase(sht.name) case is = lcase("summary"), lcase("C2_UnionQuery"), lcase("Summary-Sheet") 'do nothing case else 'your code here end select I find it easier to update and understand. ========== If you had used: Dim Sht as String 'not worksheet .... sht = worksheets(i).name 'no Set statement, since sht is no longer an object. you could have used: select case lcase(sht) ..... ryguy7272 wrote: 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 -- Dave Peterson |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Tab Names from Several Sheets and Copy Last Row from Same She
Try that "select case" stuff.
ryguy7272 wrote: I got the first part working; the sheet tab names now list in Column A. I just need to copy/paste the last row from each sheet not named "Summary", or "C2_UnionQuery", or "Summary-Sheet" in the cells that correspond to the names, starting in Column B. I think it is something like the below, but that isn't working for me... Sub CopyFromSheets(ByVal strCol As String, _ ByVal strWhat As String, ByVal strPasteCol As String) Dim wks As Worksheet Dim rngFound As Range Dim rngPaste As Range Set rngPaste = Sheets("Summary").Cells(Rows.Count, _ strPasteCol).End(xlUp).Offset(1, 0) For Each wks In Worksheets On Error Resume Next Set rngFound = FindStuff(wks.Columns(strCol), strWhat) On Error GoTo 0 If Not rngFound Is Nothing Then rngFound.Offset(0, 1).Copy rngPaste Set rngFound = Nothing End If Set rngPaste = rngPaste.Offset(1, 0) Next wks End Sub Any thoughts??? -- RyGuy "ryguy7272" wrote: 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 -- Dave Peterson |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Tab Names from Several Sheets and Copy Last Row from Same She
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Tab Names from Several Sheets and Copy Last Row from Same
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Tab Names from Several Sheets and Copy Last Row from Same
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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Match Names in columns then copy associated info from 2 sheets | Excel Worksheet Functions | |||
move or copy sheets doesn't copy format | Excel Worksheet Functions | |||
how to copy workbook names and worksheet names to columns in acces | Excel Programming | |||
in VBA Sheets("mysheet").Copy Befo=Sheets(1) how do i get a reference to the newly created copy of this sheet? | Excel Worksheet Functions | |||
copy sheet1 and name sheets using names from a range | Excel Programming |