I have a workbook that contains 100+ worksheets. The far left workbook is named "List" the code below copies a selected range from the active sheets and places it in "List". The workbook is a contains a P&L for each department and the code is basically taking the review notes for each department and consolidating on the "List" worksheet.
The "List" worksheet is at the far left and you can see through worksheet "00-205" (Image 1 below). The worksheets increase in numerical order, so if I scroll to the right to where 00-205 is the left most sheet (Image 2 below) you no longer see the "List" sheet. Assuming I run the VBA on worksheet 00-210 while on Image 2, worksheet 00-210 remains the active sheet, however, the scroll bar with worksheet names reverts to that of Image 1.
Is there a way to modify the code so that it does not shift the tab names at the bottom to show "List" as the first worksheet after copy data each time?
Image 1:
Image 2:
The "List" worksheet is at the far left and you can see through worksheet "00-205" (Image 1 below). The worksheets increase in numerical order, so if I scroll to the right to where 00-205 is the left most sheet (Image 2 below) you no longer see the "List" sheet. Assuming I run the VBA on worksheet 00-210 while on Image 2, worksheet 00-210 remains the active sheet, however, the scroll bar with worksheet names reverts to that of Image 1.
Is there a way to modify the code so that it does not shift the tab names at the bottom to show "List" as the first worksheet after copy data each time?
VBA Code:
Sub Sheetname()
Application.ScreenUpdating = False
' Store the currently active worksheet
Dim originalSheet As Worksheet
Set originalSheet = ActiveSheet
Dim myRange As Range
Set myRange = Selection
Dim Lr As Long
Lr = Worksheets("List").Range("A" & Rows.Count).End(xlUp).Row
' Lr = Worksheets("List").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
myRange.Copy
Worksheets("List").Range("A" & Lr + 1).PasteSpecial Paste:=xlPasteAllExceptBorders
Worksheets("List").Range("I" & Lr + 1).Value = myRange.Parent.name
' Clear the clipboard and remove the "dancing ants"
Application.CutCopyMode = False
' Reactivate the original worksheet
originalSheet.Activate
Application.ScreenUpdating = True
End Sub
Image 1:
Image 2: