Copy Data to Running List on Another Worksheet - Need to add sheet name from selected Range

[bbalch]

Hello everyone,

I have some vba I use on a workbook with multiple tabs. The code copies a selected range from a tab (the range will be a single row - columns A - H) each time it's selected and pastes the selected range to the next available row on the sheet named "List".

2 Questions:
1) I would like to add the sheet name in column I on the "List" sheet to document where the data came from. For example, if data from the sheet "00-100" Range("A10:H10") is copied to the "List" sheet and pasted to Range("A5:H5") I would like to add "00-100" in Cell I5. See the attached image - with the green cell as the desired outcome.
- Any suggestions on how to do this?
2) Is there a better way to do this than the code below? This code seems to be a little slow for a copying and pasting a range of 8 cells.

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

 

[Tupe77]

Would this work for you?

Sub Sheetname()

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

End Sub

 

[mart37]

myRange.Copy Worksheets("List").Range("A" & Lr + 1)

 

[bbalch]

Thank you very much! Those both did the trick.