Warning: file_get_contents(/data/phpspider/zhask/data//catemap/1/visual-studio-2012/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel VBA宏-在调试中运行,在运行时不工作_Excel_Vba - Fatal编程技术网

Excel VBA宏-在调试中运行,在运行时不工作

Excel VBA宏-在调试中运行,在运行时不工作,excel,vba,Excel,Vba,我创建了一个宏,它根据一列从主文件创建多个工作簿 Sub Split_into_separate_files() With Application .ScreenUpdating = False .DisplayAlerts = False End With ThisWorkbook.Sheets(1).Activate 'removes existing filters On Error Resume Next Sheet1.ShowAllData

我创建了一个宏,它根据一列从主文件创建多个工作簿

Sub Split_into_separate_files()


With Application
        .ScreenUpdating = False

        .DisplayAlerts = False
End With


ThisWorkbook.Sheets(1).Activate

'removes existing filters

On Error Resume Next
Sheet1.ShowAllData
On Error GoTo 0

'variables declaration
Dim lsrClm As Long
Dim lstRow As Long
Dim lstRow_UNQ As Long
Dim Val As Range
Dim uniques As Range
Dim clm As String, clmNo As Long
Dim lst As Long
Dim lstClm As Long
Dim LR As Long
Dim Uniqu As Range

'finding the last row in master file and creates range from column that I want to filter in loop
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
On Error GoTo handler
clm = Application.InputBox("From which column you want create files" & vbCrLf & "E.g. A,B,C,AB,ZA etc.")
clmNo = Range(clm & "1").Column
Set uniques = Range(clm & "8:" & clm & lstRow)
    
'creating new worksheet and pasting values for loop
Sheets.Add
On Error Resume Next
ActiveSheet.Name = "uniques"
Sheets("uniques").Activate
On Error GoTo 0
uniques.Copy
Cells(2, 1).Activate
ActiveCell.PasteSpecial xlPasteValues
Range("A1").Value = "Uniques"

'removing duplicates
lst = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:A" & lst).Select
ActiveSheet.Range(Selection.Address).RemoveDuplicates Columns:=1, Header:=xlNo
    
    lstRow_UNQ = Cells(Rows.Count, 1).End(xlUp).Row
    Set Val = Range("A2:A" & lstRow_UNQ)

'filtering loop
    For Each Uniqu In Val

'setting dataset size
        Sheets("F21").Activate
        LR = Cells(Rows.Count, 1).End(xlUp).Row
        lstClm = Cells(7, Columns.Count).End(xlToLeft).Column
        Dim dataSet As Range
        Set dataSet = Range(Cells(7, 1), Cells(LR, lstClm))
'filtering values
        dataSet.AutoFilter field:=clmNo, Criteria1:=Uniqu.Value
'setting dataset size for copying
        LR = Cells(Rows.Count, 1).End(xlUp).Row
        lstClm = Cells(7, Columns.Count).End(xlToLeft).Column
        Set dataSet = Range(Cells(5, 1), Cells(LR, lstClm))
        dataSet.Copy
'creating new workbook and pasting values
        Dim WB As Workbook
        Set WB = Workbooks.Add
        Range("A2").PasteSpecial
        Sheets(1).Cells.Copy
        Sheets(1).Cells.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        ActiveWindow.Zoom = 70
        Columns("A:DB").EntireColumn.AutoFit
        WB.SaveAs Filename:= _
        "here is directory"
        ActiveWorkbook.Close
        Sheets("F21").ShowAllData
        
     Next Uniqu


With Application
        .ScreenUpdating = True

        .DisplayAlerts = True

        .AlertBeforeOverwriting = True

        .Calculation = xlCalculationAutomatic
End With

    ThisWorkbook.Sheets("F21").Activate

    MsgBox "Well Done!"

    Exit Sub

    ActiveSheet.ShowAllData

'konczy makro jezeli jest blad
handler:

With Application
        .ScreenUpdating = True

        .DisplayAlerts = True

        .AlertBeforeOverwriting = True

        .Calculation = xlCalculationAutomatic
End With


End Sub
主工作表名为“F21”

当我运行这个宏时,我得到一个错误:下标超出范围-指示这一行->工作表(“F21”)。激活

从调试模式运行宏时,没有错误


你能帮忙吗?

@BigBen是对的,你应该总是避免事件(选择、复制、激活等)

在您的情况下,问题是您试图激活另一个工作簿中的工作表,
Thisworkbook.Sheets(“F21”)。激活将起作用

但您只是将一个范围的值粘贴到另一个范围中。Excel中的单元格只是变量

您可以将一个范围的值传递给另一个范围。例如:

Thisworkbook.Sheets("F21").Range("A1:A10").Value = Thisworkbook.Sheets("F21").Range("B1:B10").Value
这样就不需要选择、激活或复制,而且比使用事件更快。

您可能需要阅读。它主要讨论避免
选择
,但同样的原则适用于避免
激活
。如果使用工作簿和工作表限定
范围
单元格
调用,则不会遇到此问题。