如何用VBA根据供应商编号与日期范围将Excel数据复制至新工作表？

下面是一套直接可用的VBA代码，能实现你要的需求——指定供应商编号和日期范围后，自动筛选并复制符合条件的数据到新工作表：

Sub FilterAndCopySupplierData()
    Dim sourceSheet As Worksheet
    Dim inputSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim supplierID As String
    Dim startDate As Date
    Dim endDate As Date
    Dim lastRow As Long
    Dim targetLastRow As Long
    
    ' 定义工作表（根据你的实际表名修改）
    Set sourceSheet = ThisWorkbook.Worksheets("数据源") ' 存放原始数据的表
    Set inputSheet = ThisWorkbook.Worksheets("输入界面") ' 用来输入查询条件的表
    On Error Resume Next
    Set targetSheet = ThisWorkbook.Worksheets("筛选结果")
    If Err.Number <> 0 Then
        ' 如果目标表不存在就新建
        Set targetSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        targetSheet.Name = "筛选结果"
    End If
    On Error GoTo 0
    
    ' 获取输入的查询条件（假设输入区域是：供应商编号在A1，开始日期在B1，结束日期在C1，可自行修改）
    supplierID = inputSheet.Range("A1").Value
    startDate = inputSheet.Range("B1").Value
    endDate = inputSheet.Range("C1").Value
    
    ' 清空目标表原有数据（保留表头）
    targetSheet.Range("A2:" & targetSheet.Cells(targetSheet.Rows.Count, targetSheet.Columns.Count).Address).ClearContents
    
    ' 找到数据源的最后一行
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 应用筛选
    sourceSheet.Range("A1:" & sourceSheet.Cells(lastRow, sourceSheet.Columns.Count).Address).AutoFilter
    ' 筛选供应商编号（假设供应商编号在A列，日期在B列，根据实际列修改）
    sourceSheet.Range("A1:" & sourceSheet.Cells(lastRow, sourceSheet.Columns.Count).Address).AutoFilter Field:=1, Criteria1:=supplierID
    sourceSheet.Range("A1:" & sourceSheet.Cells(lastRow, sourceSheet.Columns.Count).Address).AutoFilter Field:=2, Criteria1:=">=" & CLng(startDate), Operator:=xlAnd, Criteria2:="<=" & CLng(endDate)
    
    ' 复制筛选后的数据（跳过表头）
    sourceSheet.Range("A2:" & sourceSheet.Cells(lastRow, sourceSheet.Columns.Count).Address).SpecialCells(xlCellTypeVisible).Copy
    
    ' 粘贴到目标表的第一个空行
    targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
    targetSheet.Range("A" & targetLastRow).PasteSpecial xlPasteValuesAndNumberFormats
    
    ' 取消筛选
    sourceSheet.AutoFilterMode = False
    
    ' 提示完成
    MsgBox "数据筛选复制完成！", vbInformation
End Sub

关键说明： #

• 你需要根据自己的实际情况修改代码中的工作表名称（比如"数据源"、"输入界面"）和列位置（比如供应商编号所在列、日期所在列）。
• 输入条件的单元格位置（A1、B1、C1）也可以根据你的输入界面调整。
• 代码会自动判断"筛选结果"工作表是否存在，不存在则新建。
• 复制时会保留数据的数值和格式，避免格式错乱。

使用方法： #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器。
2. 插入一个新模块：右键点击左侧的工作簿名称 → 插入 → 模块。
3. 将上面的代码粘贴到模块中，修改对应的表名和列位置。
4. 返回Excel，在"输入界面"工作表的指定单元格输入供应商编号和日期范围，然后运行这个宏（可以通过开发工具→宏→选择FilterAndCopySupplierData→执行）。

内容的提问来源于stack exchange，提问作者FarideAb