Value not copied into the correct Range

Question

I have multiple sheets in the same workbook, and I'm trying to copy certain cell from sheet 1, 2, & etc. and paste into a column G on sheet "Claim".

Sheet 1, 2, &x have the same format.

When copying over, I'd like to paste from the first empty cell up to the count of total records from sheet 1/2/x.

The problems are

1. The value pasted onto Column keep getting overridden when handling multiple sheets.
2. The copied from value - I only need a component of the same cell, but not sure how to achieve that. e.g., MID(Cell,5,11)

sheet 1, 2 &x are protected sheets which I import from elsewhere and I don't really want to write

Sub AddClaimRef()
Dim nrow As Long
Dim Lastrow As Long


'Add Claim Reference
For x = 1 To Sheets.Count
If Worksheets(x).Range("A2").Value = "STORE NAME:" Then
Worksheets(x).Select
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Cells(1, 9).Copy


Worksheets("Claim").Select
nrow = ActiveSheet.Cells(Rows.Count, 7).End(xlUp).Row
Range(Cells(nrow + 1, 7), Cells(Lastrow - 9, 7)).Select
ActiveSheet.Paste
End If
Next


End Sub

Expected Result -

1. Mid(Cell(1,9),5,11) get copied from sheet 1 - x, but I don't know how to do that.I was only able to copy cell(1,9)

2. If sheet 1 has 100 records with cell value "SHEET1", sheet 2 has 200 records with cell value "SHEET2" I'd expect Column G to populate value "SHEET1" from Row 2 to Row 101 and populate "SHEET2" from Row 102 to 302

But the actual output is that Row 2 to Row 101 gets overridden by value "SHEET2"

Answer 1

1. NO .Select and NO .Activate and NO .ActiveSheet
2. Declare all of your variables (x) and qualify all of your ranges [What Sheet?].Cells(.....
3. You need to calculate the last row on your paste sheet as this changes with each loop
4. This is set to copy from Range("I9") on each sheet you loop through
5. This is set to paste on Last Row + 1 on Column G and will repeat the value as determined by ws.Column A
6. Indenting your code properly makes the loops and steps much easier to follow/debug/update in future

---

Option Explicit

Sub Update()

Dim Claim As Worksheet: Set Claim = ThisWorkbook.Sheets("Claim")
Dim ws As Worksheet, LRp As Long, LRc As Long

For Each ws In Worksheets
    If ws.Name <> Claim.Name Then
        If ws.Range("A2") = "STORE NAME:" Then

            LRc = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            LRp = Claim.Range("G" & Claim.Rows.Count).End(xlUp).Offset(1).Row
            Claim.Range(Claim.Cells(LRp, 7), Claim.Cells(LRp + LRc - 1, 7)).Value = Mid(ws.Range("I9"), 5, 11)

        End If
    End If
Next ws

End Sub