VBA Macro - Loop and get value then ovewrite the desired cell - excel

Question

I created a loop that will get the value of one cell to another cell under the same sheet.
The expected result should be this, if the loop runs it will get the 1st value then run my created procedure
next overwrite the same cell get the 2nd value then execute again my created procedure then get 3rd value .. overwrite the cell ..exec proc and so on ...
But my codes only get the last value of the selection.
Public Sub SpecNum()
Dim lrow As Long
Range("A2").Select
lrow = Selection.End(xlDown).Row
For x = 2 To lrow
Range("C2").Value2 = Cells(x, 1).Value2
Next x
Number
End Sub
Public Sub Number()
Dim SpecNum, pref, lastCell As String
Dim lrow As Long
SpecNum = Range("C2").Value2
For x = 2 To 6
Worksheets("Sheet3").Select
pref = Cells(x, "E").Value2
Cells(x, "C").Value2 = SpecNum & pref
Range("C2", Range("C2").End(xlToRight).End(xlDown)).Copy
Next x
Worksheets("Sheet1").Select
Range("A250").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End Sub
output when moving the number inside the loop.. it doubled/tripled the values
expected result:

Answer 1

I refactored your code a bit. First of all - you should learn how to avoid using Selections (How to avoid using Select in Excel VBA).
Code without Selections is more flexible and less confusing.
Hope it works as you wanted:
Option Explicit
Public Sub SpecNum()
Dim lrow As Long
Dim x As Long
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet3")
lrow = ws.Range("A2").End(xlDown).row
For x = 2 To lrow
ws.Range("C2").Value2 = ws.Cells(x, 1).Value2
Number
Next x
End Sub
Public Sub Number()
Dim SpecNum As String
Dim pref As String
Dim lrow As Long
Dim x As Long
Dim wb As Workbook
Dim ws3 As Worksheet
Dim ws1 As Worksheet
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Sheet1")
Set ws3 = wb.Worksheets("Sheet3")
SpecNum = ws3.Range("C2").Value2
For x = 2 To 6
pref = ws3.Cells(x, "E").Value2
ws3.Cells(x, "C").Value2 = SpecNum & pref
Next x
ws3.Range("C2", ws3.Range("C2").End(xlToRight).End(xlDown)).Copy
ws1.Range("A250").End(xlUp).Offset(1, 0).PasteSpecial
End Sub

Answer 2

modified your loop structures. May try
Public Sub SpecNum()
Dim lrow As Long
Range("A2").Select
lrow = Selection.End(xlDown).Row
For X = 2 To lrow
Range("C2").Value2 = Cells(X, 1).Value2
Number
Next X
End Sub
Public Sub Number()
Dim SpecNum, pref, lastCell As String
Dim lrow As Long
SpecNum = Range("C2").Value2
For X = 2 To 6
Worksheets("Sheet3").Select
pref = Cells(X, "E").Value2
Cells(X, "C").Value2 = SpecNum & pref
'Range("C2", Range("C2").End(xlToRight).End(xlDown)).Copy
Range("C" & X, Range("C" & X).End(xlToRight)).Copy
Worksheets("Sheet1").Select
Range("A15").End(xlDown).End(xlDown).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next X
End Sub
Or may please opt for simplified solution in single procedure
Public Sub SpecNum2()
Dim lrow As Long
Worksheets("Sheet1").Range("A2").Select
lrow = Selection.End(xlDown).Row
TrgRw = 15
For X = 2 To lrow
NumX = Worksheets("Sheet1").Cells(X, 1).Value2
For Y = 2 To 6
TrgRw = TrgRw + 1
Worksheets("Sheet3").Select
pref = Cells(Y, "E").Value2
Cells(Y, "C").Value2 = NumX & pref
'Range("C2", Range("C2").End(xlToRight).End(xlDown)).Copy
Range("C" & Y, Range("C" & Y).End(xlToRight)).Copy
Worksheets("Sheet1").Select
Range("A" & TrgRw).Select
ActiveSheet.Paste
Next Y
Next X
End Sub
Hope It will work