Excel Vba使用按钮自动筛选将所有excel数据复制到工作表

Question

我试图编写一个VBA代码，当我单击按钮时：

1. 创建新工作表
2. 检查文件夹（固定地址）中的所有excel文件
3. 对于每个等于的单元格值，将自动过滤器应用于列（K13：K） 复制到10个数字后（或在应用过滤器后复制所有数字）
4. 全部吸收并复制到新工作表
5. 在A1中创建一个新过滤器，我们有需要选择列表的各种产品
6. 新表中的数据将自动调整大小 行和列，VerticalAlignment，Horizo​​ntalAlignment和自动换行

注意：所有数据必须来自我们拥有所有excel文件的文件夹。

还有一个错误

  

我们无法对合并的单元格执行此操作。

Sub CopyRangeToAnotherSheet()

    '*-*-*-*

    '*-*-
    Workbooks.Open ("C:\Users\username\Desktop\foldername\Update\filename.xlsm")

    Sheets("PFMEA").Range("A12:AD3377").Copy
    'Activate the destination worksheet
        Sheets("PFMEA").Activate
    'Select the target range
    Range("A2").Select
    'Paste in the target destination
    ActiveSheet.Paste

    Application.CutCopyMode = False
    AutoFilterMode = False

                Range("K1:K3377").AutoFilter
    ThisWorkbook.Sheets("critical").Range("K1:K3377").AutoFilter Field:=1, Criteria1:=10

    Worksheets("critical").Range("d10").WrapText = True

    '*-*-*-*Resize_Columns_And_Rows_No_Header

        Dim currentSheet As Worksheet

        Set currentSheet = ActiveSheet

        Dim Sheet As Worksheet
        For Each Sheet In ActiveWorkbook.Worksheets
            With Sheet
                With Worksheets("Critical").Range("A:AD").Cells.Rows
                    Worksheets("Critical").Range("A:AD").WrapText = True
                    Worksheets("Critical").Range("A:AD").VerticalAlignment = xlCenter
                    Worksheets("Critical").Range("A:AD").EntireRow.AutoFit
                    Worksheets("Critical").Range("A:AD").HorizontalAlignment = xlCenter
                End With '.Cells.Rows
                Worksheets("Critical").Range("A:AD").Columns.EntireColumn.AutoFit
                Worksheets("Critical").Range("A:AD").EntireRow.AutoFit
            End With 'sheet
        Next Sheet


    '          *-*- Auto filter for product

              ' Range("A1:AD1").AutoFilter
                ThisWorkbook.Sheets("critical").Range("A1:AD1").AutoFilter Field:=1

        currentSheet.Activate

    '*******************************
    'Create a Button For Return Back

    ActiveSheet.Buttons.Add(30, 1, 60, 20).Select
    Selection.Name = "Return Back"

    Selection.OnAction = "CheckTotals"
    ActiveSheet.Shapes("New Button").Select

    Selection.Characters.Text = "Return Back"
    '*************************************

    '**************************************
    Sub returnback()
    ThisWorkbook.Sheets("RISK_PRIORITY").Activate
    End Sub



`