Sub test()
'Updateby Extendoffice 20160616
Dim xCount As Integer
Dim col As Integer
Dim O As Worksheet
On Error Resume Next
Set O = Worksheets(Cells(ActiveCell.Row, "B").Value)
If Err <> 0 Then
Err.Clear
MsgBox "La colonne B de la cellule sélectionnée ne contient pas un nom d'onglet existant !. Opération avortée."
Exit Sub
End If
On Error GoTo 0
LableNumber:
xCount = Application.InputBox("Nombres de ligne à copier", "macro copie de lignes", , , , , , 1)
If xCount < 1 Then
MsgBox "Entre un nombre superieur a 0", vbInformation, "macro copie de lignes"
GoTo LableNumber
End If
col = 1
For x = 1 To xCount
ActiveCell.EntireRow.Copy
ActiveCell.Offset(x, 0).EntireRow.Insert Shift:=xlDown
Cells(ActiveCell.Offset(x, 0).Row, "B").Value = ActiveCell.Value & " " & Split(Columns(col).Address(0, 0), ":")(0): col = col + 1
Next x
Application.CutCopyMode = False
col = xCount
For x = xCount To 1 Step -1
O.Copy after:=O
ActiveSheet.Name = O.Name & " " & Split(Columns(col).Address(0, 0), ":")(0): col = col - 1
Next x
End Sub