在 Excel 上复制和粘贴信息时出现宏错误

Question

我有以下问题：

我有一个名为“Template_National_Lookahead”的文件，其中 Sheet1 上有一个表格，如下所示

姓名	数据1	数据2	数据3
姓名1
	11	数据1名称1	40
	12	数据2名称1	30
	13	数据3名称1	40
	14	数据4名称1	10
	小计
姓名2
	21	数据1名称2	40
	22	数据2名称2	30
	23	数据3名称2	40
	小计
姓名3
	31	数据1名称3	40
	32	数据2名称3	30
	33	数据3名称3	40
	34	数据4名称3	30
	35	数据5名称3	40

我需要将信息放入另一个名为“Book1”的 Excel 中，其中结构几乎相同，但名称是混合的。

我尝试使用此代码：

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

但是，结果我有了

姓名	数据1	数据2
姓名1
	11	数据1名称1
	12	数据2名称1
姓名2	13	数据3名称1
	14	数据4名称1
	22	数据2名称2
	23	数据3名称2
姓名3
	31	数据1名称3
	32	数据2名称3
	33	数据3名称3
	34	数据4名称3
	35	数据5名称3

此外，程序每次都会将编号为 Data 1: 11, 12, 13, 14 的行粘贴到同一单元格中。我的意思是，他们粘贴名称 2，然后在同一位置再次粘贴先前的数据，然后粘贴名称 3 的信息，然后再次在同一位置再次粘贴先前的数据。

如果有人可以帮助找到问题，我会很高兴。

谢谢大家。

Answer 1

假设在目标表上

行	P 栏
2	姓名1
3	姓名2
4	姓名3

将缺少的

Subtotal

添加到

Name 3

的源表底部，因为您正在查找它。

我使用了

PasteSpecial

方法，而不是在表中插入行并且不知道

NAME

实际有多长的

Insert

。

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

这是目标表的之前/之后。