如何使用Excel VBA将列名称从一张图纸复制到另一张图纸

我已经写了一个代码来找出两张纸之间的差异，差异将被粘贴到一张新的纸上。现在，我需要这些列名以及在工作表中。因为我是宏的初学者。我不能那样做。请帮帮我。提前谢谢

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
Application.ScreenUpdating = False
Application.StatusBar = "Creating the report..."
Set rptWB = Workbooks.Add
Application.DisplayAlerts = False
While Worksheets.Count > 1
    Worksheets(2).Delete
Wend
Application.DisplayAlerts = True
With ws1.UsedRange
    lr1 = .Rows.Count
    lc1 = .Columns.Count
End With
With ws2.UsedRange
    lr2 = .Rows.Count
    lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
If maxR < lr2 Then maxR = lr2
If maxC < lc2 Then maxC = lc2
DiffCount = 0
For c = 1 To maxC
    Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
    For r = 1 To maxR
        cf1 = ""
        cf2 = ""
        On Error Resume Next
        cf1 = ws1.Cells(r, c).FormulaLocal
        cf2 = ws2.Cells(r, c).FormulaLocal
        On Error GoTo 0
        If cf1 <> cf2 Then
            DiffCount = DiffCount + 1
            Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
            ws1.Cells(r, c).Interior.ColorIndex = 12
            ws1.Cells(r, c).Copy
            ws2.Cells(r, c).Interior.ColorIndex = 12
            ws2.Cells(r, c).Copy
         End If
    Next r
Next c
Application.StatusBar = "Formatting the report..."
With Range(Cells(1, 1), Cells(maxR, maxC))
    .Interior.ColorIndex = 19
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    On Error Resume Next
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
    On Error GoTo 0
End With
Columns("A:IV").ColumnWidth = 20
rptWB.Saved = True
If DiffCount = 0 Then
    rptWB.Close False
End If
Set rptWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox DiffCount & " cells contain different formulas!", vbInformation, _
    "Compare " & ws1.Name & " with " & ws2.Name
End Sub

Sub TestCompareWorksheets()
' compare two different worksheets in the active workbook
CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
' compare two different worksheets in two different workbooks
' CompareWorksheets ActiveWorkbook.Worksheets("Sheet1"), _
    ' Workbooks("Compare Data Using Macro -New.xlsm").Worksheets("Sheet2")
End Sub

子比较工作表（ws1作为工作表，ws2作为工作表）
Dim r为长，c为整数
尺寸lr1为长，lr2为长，lc1为整数，lc2为整数
Dim maxR为长，maxC为整数，cf1为字符串，cf2为字符串
将rptWB作为工作簿进行Dim，将DiffCount设置为Long
Application.ScreenUpdating=False
Application.StatusBar=“正在创建报告…”
设置rptWB=工作簿。添加
Application.DisplayAlerts=False
而工作表。计数>1
工作表（2）.删除
温德
Application.DisplayAlerts=True
使用ws1.UsedRange
lr1=.Rows.Count
lc1=.Columns.Count
以
使用ws2.UsedRange
lr2=.Rows.Count
lc2=.Columns.Count
以
maxR=lr1
maxC=lc1
如果maxR

基本上：

ws1.Activate
Range(Cells(1, 1), Cells(1, lc1)).Copy
[your destination worksheet].Range("A1").PasteSpecial Paste:=xlPasteAll

但是。。。您在哪里定义了ws1和ws2？目标工作表位于其他工作簿中。。。将数据粘贴到新工作表的何处

不久前，我写了一个宏来实现这一点：

' Macro: ActualizarDatos()
Sub ActualizarDatos()
    Dim num_sheets As Integer
    Dim last_row_s1, last_col_s1 As Long
    Dim last_row_s2, last_col_s2 As Long
    Dim lookup_range As Range
    Dim my_index, my_target_index As Variant

    num_sheets = ActiveWorkbook.Sheets.Count
    ' Verifica el numero de hojas
    If num_sheets >= 2 Then
        If num_sheets = 2 Then
            ' Añadir nueva hoja al final
            Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "RESULTADO"
        End If
        ' Para determinar el tamaño de las hojas 1 y 2
        last_row_s1 = ActiveWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
        last_col_s1 = ActiveWorkbook.Sheets(1).Range("a1").End(xlToRight).Column
        last_row_s2 = ActiveWorkbook.Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
        last_col_s2 = ActiveWorkbook.Sheets(2).Range("a1").End(xlToRight).Column
        ' Copia los datos de la Hoja-1 en la Hoja-3 de resultado
        Sheets(1).Activate
        Range(Cells(1, 1), Cells(last_row_s1, last_col_s1)).Copy
        Worksheets(3).Range("A1").PasteSpecial Paste:=xlPasteAll
        'Worksheets(3).Range("A1").PasteSpecial Paste:=xlPasteFormats
        'Worksheets(3).Range("A1").Paste

        Sheets(2).Activate
        Set lookup_range = Range(Cells(1, 1), Cells(last_row_s2, 1))
        ' Recorre los indices (columna A) de la Hoja-1 y busca las coincidencias en
        '   la Hoja-2
        For num_row = 2 To last_row_s1
            my_index = Sheets(1).Cells(num_row, 1).Value
            my_target_index = Application.Match(my_index, lookup_range, 0)
                If Not IsError(my_target_index) Then
                    ' Encontrada la coincidencia de índices se recorren las filas de
                    '   encabezados de columnas (fila 1) para buscar coincidencias.
                    For num_col = 2 To last_col_s1
                        title_origin = Sheets(1).Cells(1, num_col)
                        title_target_index = Application.Match(title_origin, _
                            Sheets(2).Range(Cells(1, 1), Cells(1, last_col_s2)), 0)
                            If Not IsError(title_target_index) Then
                                ' Encontrada la coincidencia de encabezados de columna
                                ' comprobar si el valor de la celda es distinto y no Null
                                ' copiar a hoja 3 llamando a subrutina ActualizarCelda
                                ActualizarCelda Sheets(3).Cells(num_row, num_col), _
                                    Sheets(2).Cells(my_target_index, title_target_index)
                            End If
                    Next num_col
                End If
        Next num_row
        'ActiveSheet.Range("a1", Range("a1").End(xlDown).End(xlToRight)).Select

        ' Debug purpose
        ' MsgBox "HOJA-1. Número de Filas: " & last_row_s1 & vbNewLine & "Número de Columnas: " & last_col_s1
        ' MsgBox "HOJA-2. Número de Filas: " & last_row_s2 & vbNewLine & "Número de Columnas: " & last_col_s2

    Else
        MsgBox ("ERROR! Se necesita un mínimo de 2 hojas")
    End If

End Sub


' Subrutina privada de ActualizarDatos()
' parametros:
'   celdaOrigen; tipo Range, dato de la hoja-3 original
'   celdaDestino; tipo Range, dato de la hoja-2
' verifica si el contenido de la celda destino es diferente a la celda origen
'   y en ese caso actualiza su valor y cambia el fondo a Amarillo.
Private Sub ActualizarCelda(ByVal celdaOrigen, celdaDestino As Range)
    If (Not celdaDestino.Value = Empty) And UCase(celdaOrigen.Value) <> UCase(celdaDestino.Value) Then
        celdaDestino.Copy
        celdaOrigen.PasteSpecial Paste:=xlPasteAll
        ' celdaOrigen.Value = UCase(celdaDestino.Value) DESCARTADO POR NO CONSERVAR FORMATO FECHA
        celdaOrigen.Interior.ColorIndex = 6     ' Formato fondo de celda Amarillo.
        ' MsgBox celdaOrigen.Value
    End If

End Sub

宏：执行zardatos（） 次级方案 Dim num_图纸为整数 调暗最后一行，最后一列，长度相同 调暗最后一行，最后一列 Dim查找范围作为范围 将my_索引、my_目标索引变暗为变量 num_sheets=ActiveWorkbook.sheets.Count “验证”是一个数字 如果张数>=2，则 如果num_sheets=2，则 “Añadir nueva hoja al-final Worksheets.Add（之后：=Sheets（Sheets.Count））.Name=“RESULTADO” 如果结束 “第1年和第2年 最后一行\u s1=ActiveWorkbook.Sheets（1）.Range（“A”&Rows.Count）.End（xlUp）.row last_col_s1=ActiveWorkbook.Sheets（1）.范围（“a1”）.结束（xlToRight）.列 最后一行\u s2=ActiveWorkbook.Sheets（2）.Range（“A”&Rows.Count）.End（xlUp）.row last_col_s2=ActiveWorkbook.Sheets（2）.范围（“a1”）.结束（xlToRight）.列 “Hoja-1和Hoja-3数据副本” 第（1）页。激活 范围（单元格（1，1），单元格（最后一行，最后一列），复制 工作表（3）.范围（“A1”）.粘贴特殊粘贴：=xlPasteAll '工作表（3）.范围（“A1”）.粘贴特殊粘贴：=xlPasteFormats '工作表（3）.范围（“A1”）.粘贴 第（2）页。激活 设置查找范围=范围（单元格（1，1），单元格（最后一行）s2，1）） “记录Hoja-1的服务水平指数（A列）和符合性指数” “la Hoja-2 对于num\u row=2到最后一行\u s1 我的索引=工作表（1）.Cells（num\u行，1）.Value my_target_index=Application.Match（my_index，lookup_range，0） 如果不是iError（我的目标索引），那么 “这是一次偶然的机会 “encabezados de columnas（fila 1）para buscar Concerncias。 对于num_col=2到last_col_s1 title_origin=表格（1）。单元格（1，num_col） title\u target\u index=Application.Match（title\u原点_ 表（2）.范围（单元格（1，1），单元格（1，最后一列s2）），0） 如果不是IsError（标题\目标\索引），则 “安康特拉·德恩卡贝萨多斯·德科伦纳（Encontrada la Concerncia de encabezados de columna）酒店 “这是塞尔达山谷的尽头，没有空。” “我是一个三人一组的人 表格（3）单元格（行数、列数）_ 表（2）.单元格（我的目标索引，

For r = 1 To maxR
    cf1 = ""
    cf2 = ""
    On Error Resume Next
    cf1 = ws1.Cells(r, c).FormulaLocal
    cf2 = ws2.Cells(r, c).FormulaLocal
    On Error GoTo 0
    Cells(r, c).Formula = ws1.Cells(r, c)
    If cf1 <> cf2 Then
        DiffCount = DiffCount + 1
        Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
        ws1.Cells(r, c).Interior.ColorIndex = 12
        ws1.Cells(r, c).Copy
        ws2.Cells(r, c).Interior.ColorIndex = 12
        ws2.Cells(r, c).Copy
     End If
Next r