Excel VBA宏代码：复制数据并插入

        这篇文章介绍了一段Excel VBA宏代码，用于在一个工作表中根据用户选择的内容筛选另一个工作表中的数据，并将筛选结果复制到原工作表中的选定行下方。该代码有助于提高数据处理的效率，特别是在需要从一个工作表中筛选数据并将其插入到另一个工作表时。这个代码主要用来划分企业级次。

        代码功能概述

        该VBA宏代码实现以下功能：

1. 获取用户在Sheet1中选定单元格的内容。
2. 在Sheet2中根据选定内容进行筛选。
3. 统计筛选结果的行数。
4. 在Sheet1中选定行的下方插入相同数量的空行。
5. 按照指定顺序（B、E、G、C）从Sheet2中复制数据并粘贴到Sheet1的相应位置。

        主要步骤解析

    1、获取选定单元格的内容

Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")

         这段代码指定了我们要操作的工作表，即Sheet1和Sheet2。

    2、获取选定单元格的内容

selectedContent = Selection.Value

        这段代码获取用户在Sheet1中选定的单元格内容，作为筛选条件。 如sheet1的其中一个级次的企业名称为A，如图为sheet1表，表头为我需要获取sheet3表的内容：

    3、筛选Sheet2中的数据

ws2.Rows(4).AutoFilter Field:=1, Criteria1:=selectedContent

         这段代码在Sheet2中应用筛选器，以A列为筛选字段，从第四行开始作为表头筛选出与选定内容匹配的行。为什么这么操作，由于企企查查数据导出经过调整，我需要获取标黄表头的内容，如下图（标黄）：

    4、统计筛选结果的行数

Set rng = ws2.Range("A5:A" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
rowsToCopy = rng.Count

        这段代码获取筛选结果的行数。 如筛选sheet1表中的A企业，如下图，会自动获取A的数量，即要插入的行数。如下图，会自动筛选出3个A，会在sheet1表中选定A单元格的下面插入3行。

    5、复制并粘贴数据 

For Each cell In rng
    For i = LBound(colsToCopy) To UBound(colsToCopy)
        Set copyRange = ws2.Cells(cell.Row, ws2.Columns(colsToCopy(i)).Column)
        Set pasteRange = ws1.Cells(targetRow, lastNonEmptyCol + colOffset)
        pasteRange.Value = copyRange.Value
    Next i
    targetRow = targetRow + 1
Next cell

         这段代码按照指定的列顺序（B、E、G、C），列所对应sheet1表头的数据，故按照该顺序进行排序，从Sheet2中复制数据，并粘贴到Sheet1的相应位置，且在插入行后偏移一个单元格。

   6、运行后结果

    7、代码片段

Option Explicit

Sub 复制数据并插入()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow As Long, investStartRow As Long
    Dim investCount As Long, copyRange As Range, pasteRange As Range
    Dim selectedContent As String
    Dim rng As Range, cell As Range
    Dim rowsToCopy As Long

    ' 设置工作表对象
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")

    ' 获取Sheet1中选定单元格的内容
    selectedContent = Selection.Value

    ' 在Sheet2中第4行进行筛选，筛选A列内容
    ws2.Rows(4).AutoFilter Field:=1, Criteria1:=selectedContent

    ' 找到Sheet2中筛选结果的行数
    Set rng = ws2.Range("A5:A" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)

    ' 获取筛选结果行数
    rowsToCopy = rng.Count

    ' 在Sheet1中选中的任意行下方插入相同数量的空行
    Dim selectedRow As Long, lastNonEmptyCol As Long
    selectedRow = ws1.Cells(Selection.Row, "A").Row ' 获取选定行的行号
    ws1.Rows(selectedRow + 1 & ":" & selectedRow + rowsToCopy).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    ' 找到选定行中最后一个非空单元格的列号
    lastNonEmptyCol = ws1.Cells(selectedRow, ws1.Columns.Count).End(xlToLeft).Column

    ' 逐列复制并粘贴数值：按照B、E、G、C的顺序
    Dim colsToCopy As Variant
    colsToCopy = Array("B", "E", "G", "C")

    Dim i As Integer, targetRow As Long
    targetRow = selectedRow + 1
    For Each cell In rng
        For i = LBound(colsToCopy) To UBound(colsToCopy)
            ' 确定复制和粘贴的范围
            Set copyRange = ws2.Cells(cell.Row, ws2.Columns(colsToCopy(i)).Column)
            
            ' 设置粘贴范围
            Dim colOffset As Integer
            If colsToCopy(i) = "E" Then
                ' 跳过一列
                colOffset = 2
            ElseIf colsToCopy(i) = "G" Then
                colOffset = 3
            ElseIf colsToCopy(i) = "C" Then
                colOffset = 5
            Else
                colOffset = 1
            End If
            Set pasteRange = ws1.Cells(targetRow, lastNonEmptyCol + colOffset)
            
            ' 复制并粘贴数值
            pasteRange.Value = copyRange.Value
        Next i
        targetRow = targetRow + 1
    Next cell

    ' 清除剪切板内容
    Application.CutCopyMode = False

    ' 清除筛选
    ws2.AutoFilterMode = False
End Sub

 完整代码如上，如有需要，自行进行调整，别忘记先备份数据。

总结

        这段VBA宏代码为Excel用户提供了一种简便的方法，能够根据选定的内容在工作表之间进行数据筛选和复制粘贴操作。通过自动化这些步骤，用户可以节省大量时间并减少手动操作的错误。

        此代码的应用场景非常广泛，适用于需要从一个工作表中筛选数据并将其插入到另一个工作表的任何场合。如果您经常处理大量数据且需要频繁进行筛选和复制操作，此代码将极大地提高您的工作效率。

 反馈

如有不足之处，可私信或评论，一起探讨相关问题，有问必回。