Macros Error with copy and paste information on Excel

I have the following problem:

I have a file named "Template_National_Lookahead" where I have a table on Sheet1 as following

NAME	DATA 1	DATA 2	DATA 3
Name 1
	11	data1 name1	40
	12	data2 name1	30
	13	data3 name1	40
	14	data4 name1	10
	Subtotal
Name 2
	21	data1 name2	40
	22	data2 name2	30
	23	data3 name2	40
	Subtotal
Name 3
	31	data1 name3	40
	32	data2 name3	30
	33	data3 name3	40
	34	data4 name3	30
	35	data5 name3	40

I need to put the information in another Excel named "Book1" where I have, almost, the same structure but the names are mixed.

I tried using this code:

Sub CopiarInformacionDependiendoDelNombre()

    Dim archivoA As Workbook
    Dim archivoB As Workbook
    Dim hojaA As Worksheet
    Dim hojaB As Worksheet
    Dim nombre As String
    Dim celdaA As Range
    Dim celdaB As Range
    Dim ultimaFilaA As Long
    Dim rangoDatos As Range
    Dim filaSubtotalA As Long
    
    Set archivoA = Workbooks.Open("C:\Users\JL\Desktop\TEST\Template_National_Lookahead.xlsm")
    Set archivoB = Workbooks.Open("C:\Users\JL\Desktop\TEST\Book1.xlsm")

    Set hojaA = archivoA.Sheets(1)
    Set hojaB = archivoB.Sheets(1)

    For Each celdaB In hojaB.Range("P2:P" & hojaB.Cells(hojaB.Rows.Count, "P").End(xlUp).Row)
        
        nombre = celdaB.Value
        
        Set celdaA = hojaA.Range("B2:B" & hojaA.Cells(hojaA.Rows.Count, "B").End(xlUp).Row).Find(nombre, LookIn:=xlValues)
        
        If Not celdaA Is Nothing Then
            filaSubtotalA = hojaA.Range(celdaA.Offset(1, 1), hojaA.Cells(hojaA.Rows.Count, celdaA.Column + 1)).Find("Subtotal", LookIn:=xlValues).Row
            
            Set rangoDatos = hojaA.Range(celdaA.Offset(1, 1), hojaA.Cells(filaSubtotalA - 1, celdaA.Column + 2))
            
            rangoDatos.Copy
            
            Set celdaB = hojaB.Range("P2:P" & hojaB.Cells(hojaB.Rows.Count, "P").End(xlUp).Row).Find(nombre, LookIn:=xlValues)
            If Not celdaB Is Nothing Then
                celdaB.Offset(1, 1).PasteSpecial Paste:=xlPasteValues
            End If
        End If
        
    Next celdaB

    archivoB.Save
    archivoA.Save

    MsgBox "Proceso completado", vbInformation

End Sub

But, as result I have

NAME	DATA 1	DATA 2
Name 1


	11	data1 name1
	12	data2 name1
Name 2	13	data3 name1
	14	data4 name1
	22	data2 name2
	23	data3 name2
Name 3
	31	data1 name3
	32	data2 name3
	33	data3 name3
	34	data4 name3
	35	data5 name3

Also, the program paste the row with number Data 1: 11, 12, 13, 14 in the same cell everytime. I mean, they paste the name 2, and then paste de previus data again in the same place, then paste the info of name 3 and then, again, paste de preovius data again in the same place.

I will be glad if someone could help finding the problem.

Thanks to everyone.

Solution

Assume that on the target sheet

Row	Column P
2	Name 1
3	Name 2
4	Name 3

Add the missing Subtotal into the bottom of the source table for Name 3 since you look for it.

Instead of PasteSpecial which not insert rows in the table and it is unknown how long a NAME actually is, I used the Insert method.

Sub CopiarInformacionDependiendoDelNombre()

    Dim archivoA As Workbook
    Dim archivoB As Workbook
    Dim hojaA As Worksheet
    Dim hojaB As Worksheet
    Dim nombre As String
    Dim celdaA As Range
    Dim celdaB As Range
    Dim ultimaFilaA As Long
    Dim rangoDatos As Range
    Dim filaSubtotalA As Long
    
    Set archivoA =Workbooks.Open("C:\Users\JL\Desktop\TEST\Template_National_Lookahead.xlsm")
    Set archivoB =Workbooks.Open("C:\Users\JL\Desktop\TEST\Book1.xlsm")

    Set hojaA = archivoA.Sheets(1)
    Set hojaB = archivoB.Sheets(1)

    For Each celdaB In hojaB.Range("P2:P" & hojaB.Cells(hojaB.Rows.Count, "P").End(xlUp).Row)
    If celdaB <> "" Then
        nombre = celdaB.Value
        
        Set celdaA = hojaA.Range("B2:B" & hojaA.Cells(hojaA.Rows.Count, "B").End(xlUp).Row).Find(nombre, LookIn:=xlValues)
        
        If Not celdaA Is Nothing Then
            filaSubtotalA = hojaA.Range(celdaA.Offset(1, 1), hojaA.Cells(hojaA.Rows.Count, celdaA.Column + 1)).Find("Subtotal", LookIn:=xlValues).Row
            
            Set rangoDatos = hojaA.Range(celdaA.Offset(1, 1), hojaA.Cells(filaSubtotalA - 1, celdaA.Column + 2))
            
            
            Set celdaB = hojaB.Range("P2:P" & hojaB.Cells(hojaB.Rows.Count, "P").End(xlUp).Row).Find(nombre, LookIn:=xlValues)
            If Not celdaB Is Nothing Then
                celdaB.Offset(1).Resize(rangoDatos.Rows.Count).Insert xlShiftDown
                rangoDatos.Copy
                celdaB.Offset(1, 1).Insert xlShiftDown
            End If
        End If
    End If
    Next celdaB

    archivoB.Save
    archivoA.Save

    MsgBox "Proceso completado", vbInformation

End Sub

This is the before/after of the target sheet.