Kamis, 23 April 2015

[ExcelVBA] Making a sowksheet the leftmost in the tabs

 

Greetings All,

I have a routine that goes through all of the worksheets in a workbook and modifies some of them if the worksheet name begins with a particular letter. There are more worksheets than can be displayed in the tab section. For some reason when the macro is run, the end result is that the tab display is changed so that the leftmost worksheet in the workbook is the first displayed in the tabs (ie, index of 1). I would rather have the activeworksheet as the leftmost displayed tab. A clunky work around that I haveadded is to "scroll" (via using Worksheet.Activate), but this doesn't work well as I don't know how far to scroll (I don't know how many tabs are visible). Any help would be apprieciated.

Dave Gathmann


    Const TRCell As String = "A5"
   
    Dim LRow As Integer, RCol As Integer, i As Integer, SPY As Integer
    Dim LRCell As String
   
    LRow = Range(TRCell).End(xlDown).Row
    RCol = Range(TRCell).End(xlToRight).Column
    LRCell = Cells(LRow, RCol).Address



'what needs to be done


Application.ScreenUpdating = False
    For sht = 1 To ActiveWorkbook.Worksheets.Count
        If Mid(ActiveWorkbook.Worksheets.Item(sht).Name, 1, 1) = "a" Then
            With ActiveWorkbook.Worksheets.Item(sht)
                .Range(TRCell, LRCell).Copy
                .Range(TRCell, LRCell).Offset(1, 0).PasteSpecial
                .Range(TRCell).Offset(0, 1).Copy
                .Range(TRCell).Offset(1, 1).PasteSpecial Paste:=xlPasteValues
                .Range(TRCell).Value = Date + 1
                End With
            End If
        Next sht


'try to get SPY sheet as leftmost tab. Assume SPY is the active worksheet


    SPY = ActiveSheet.Index
   
    For i = 1 To WorksheetFunction.Min(SPY * 2, Worksheets.Count)
        Worksheets(i).Activate
        Next i
   
    Worksheets(SPY).Activate


Application.ScreenUpdating = True


__._,_.___

Posted by: dmgathmann@yahoo.com
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (1)
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------

.

__,_._,___

Tidak ada komentar:

Poskan Komentar