Sub FilterAndPasteData() '获取圈舍名称 Dim filterValue As String filterValue = Range("K1").Value '设置数据源和打印数据表的工作表名称 Dim sourceSheetName As String Dim printSheetName As String sourceSheetName = "数据源" printSheetName = "打印数据表" '获取数据源和打印数据表的工作表对象 Dim sourceSheet As Worksheet Dim printSheet As Worksheet Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName) Set printSheet = ThisWorkbook.Worksheets(printSheetName) '清空打印数据表中的内容 printSheet.Cells.ClearContents '筛选数据源中的圈舍字段 sourceSheet.Range("A1:F1000").AutoFilter Field:=3, Criteria1:=filterValue '将筛选后的内容复制到打印数据表中 sourceSheet.Range("A2:F1000").SpecialCells(xlCellTypeVisible).Copy printSheet.Range("A2") '取消筛选 sourceSheet.Range("A1:F1000").AutoFilter End Sub提示下标越界

感谢您的反馈。根据您提供的信息，出现下标越界的原因可能是由于数据源中的行数不足1000行，导致筛选时超出了数据范围。请尝试将代码中的范围修改为实际数据范围，例如：

sourceSheet.Range("A1:F500").AutoFilter Field:=3, Criteria1:=filterValue
sourceSheet.Range("A2:F500").SpecialCells(xlCellTypeVisible).Copy printSheet.Range("A2")

其中，将范围修改为A1:F500，并将复制范围也修改为A2:F500。这样可以避免超出数据范围而导致下标越界的问题。请尝试修改后再次运行代码，看是否能够正常执行。