VBA错误1004:范围类的特殊方法失败_Vba_Excel

VBA错误1004:范围类的特殊方法失败

vba excel

VBA错误1004:范围类的特殊方法失败,vba,excel,Vba,Excel,我现在使用的任何一种粘贴方法都有点麻烦。一张纸上的数据必须剪切粘贴到另一张纸上，但我不确定我遗漏了什么错误发生在此处，在注释“here”后不久：完整的代码可以在下面找到，谢谢你的回复 Option Explicit Public Sub Workbook_Open() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim wb As Variant Dim wsName As Varian

我现在使用的任何一种粘贴方法都有点麻烦。一张纸上的数据必须剪切粘贴到另一张纸上，但我不确定我遗漏了什么

错误发生在此处，在注释“here”后不久：

完整的代码可以在下面找到，谢谢你的回复

    Option Explicit
Public Sub Workbook_Open()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wb As Variant
Dim wsName As Variant
Dim blastrow As Variant
Dim flastrow As Variant
Dim lastrow As Variant


    ActiveWorkbook.Sheets("combined").Select

   Range("A1:U9999").ClearContents

   Dim MyObj As Object, MySource As Object, file As Variant
   file = Dir("G:\BS\Josh Whitfield\Credit_Chasing\NEW PROCESS\")
   'file level loop
   While (file <> "")
    If InStr(file, ".xlsx") > 0 Then
    Workbooks.Open "G:\BS\Josh Whitfield\Credit_Chasing\NEW PROCESS\" & file
    wb = ActiveWorkbook.Name
    'ws = ActiveSheet.Name

    Dim ws As Worksheet
    'worksheet/tab level loop
    For Each ws In ActiveWorkbook.Worksheets
            ws.Activate
            wsName = ws.Name

            'andrew code (09/12/2015)
            blastrow = Workbooks("Copy of merge.xlsb").Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row + 1
            If blastrow = 2 Then blastrow = 1
            Workbooks("Copy of merge.xlsb").Worksheets("Combined").Range("A" & blastrow & ":XFD" & blastrow).Value = _
                Workbooks(wb).Worksheets(wsName).Range("A1:XFD1").Value


        lastrow = Range("A" & Rows.Count).End(xlUp).Row

        'finding status column
        Range("M1").Select
        Do Until ActiveCell.Value = "Status" Or ActiveCell.Column > 100
            If Range("A2") = "" Then
                GoTo there
            End If

            ActiveCell.Offset(0, 1).Select
    Loop

        'looping through
    Do Until ActiveCell.Row > lastrow
        If ActiveCell.Value = "Solved" Then 'HERE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    wb = ActiveWorkbook.Name
    wb = Replace(wb, ".xlsx", "")

        ActiveCell.EntireRow.Cut
        Workbooks("copy of merge.xlsb").Activate

    'find matching company
    Range("E1").Select
    While ActiveCell.Value <> "CoName"
        ActiveCell.Offset(0, 1).Select
    Wend

    Do Until ActiveCell.Value = wb
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Value = "" Then
            ActiveCell.EntireRow.Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Loop

    'first cell in row select
    ActiveSheet.Cells(ActiveCell.Row, 1).Select

    'find matching ws
    If ws = "Be Wiser" Then
        Do Until ActiveCell.Value = "BW"
            ActiveCell.Offset(1, 0).Select
        Loop
    ElseIf ws = "Insure Wiser" Then
        Do Until ActiveCell.Value = "IW"
            ActiveCell.Offset(1, 0).Select
        Loop
    ElseIf ws = "Call Wiser" Then
        Do Until ActiveCell.Value = "CW"
            ActiveCell.Offset(1, 0).Select
        Loop
    ElseIf ws = "Quote Wiser" Then
        Do Until ActiveCell.Value = "QW"
            ActiveCell.Offset(1, 0).Select
        Loop
    ElseIf ws = "Be Wiser Business" Then
        Do Until ActiveCell.Value = "BWB"
            ActiveCell.Offset(1, 0).Select
        Loop
    ElseIf ws = "Younger But Wiser" Then
        Do Until ActiveCell.Value = "YBW"
            ActiveCell.Offset(1, 0).Select
        Loop
    End If

    'insert row and paste
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

        'lastrow = Range("A" & Rows.Count).End(xlUp).Row + 1
        'Range("A" & lastrow).Select
        'ActiveSheet.Paste
        ws.Activate
        lastrow = Range("A" & Rows.Count).End(xlUp).Row
        Cells.Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A19" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A1:U" & lastrow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("M1").Select
            Do Until ActiveCell.Value = "Status" Or ActiveCell.Column > 100
            ActiveCell.Offset(0, 1).Select
        Loop
Else
            ActiveCell.Offset(1, 0).Select
            End If

        Loop
there:
            'here
            flastrow = Workbooks("Copy of merge.xlsb").Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row

            If blastrow = flastrow Then
                Workbooks("Copy of merge.xlsb").Worksheets("Combined").Activate
                Range("A" & blastrow).Select
                ActiveCell.EntireRow.Delete
                Workbooks(wb).Worksheets(wsName).Activate
            End If

           Next ws

        Workbooks(wb).Close False

      End If
     file = Dir
  Wend

  Call storeFileNames

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

选项显式
公共子工作簿_Open（）
Application.ScreenUpdating=False
Application.DisplayAlerts=False
Dim-wb作为变体
将wsName作为变量
作为变体的行
作为变体的暗淡flastrow
变暗lastrow作为变体
ActiveWorkbook.Sheets（“组合”）。选择
范围（“A1:U9999”）。ClearContents
Dim MyObj作为对象，MySource作为对象，文件作为变量
file=Dir（“G:\BS\Josh Whitfield\Credit\u\NEW PROCESS\”）
'文件级循环
While（文件“”）
如果InStr（文件“.xlsx”）>0，则
工作簿。打开“G:\BS\Josh Whitfield\Credit\U\NEW PROCESS\”文件（&F）
wb=ActiveWorkbook.Name
'ws=ActiveSheet.Name
将ws设置为工作表
'工作表/选项卡级循环
对于ActiveWorkbook.Worksheets中的每个ws
ws.Activate
wsName=ws.Name
《安德鲁守则》（2015年12月9日）
blastrow=工作簿（“merge.xlsb的副本”）。工作表（“合并”）。范围（“A”&行数）。结束（xlUp）。行+1
如果blastrow=2，则blastrow=1
工作簿（“merge.xlsb的副本”）。工作表（“合并”）。范围（“A”&blastrow&“：XFD”&blastrow）。值=_
工作簿（wb）.工作表（wsName）.范围（“A1:XFD1”）.值
lastrow=范围（“A”和Rows.Count）.End（xlUp）.Row
'查找状态列
范围（“M1”）。选择
直到ActiveCell.Value=“Status”或ActiveCell.Column>100为止
如果范围（“A2”）=”则
转到那里
如果结束
ActiveCell.Offset（0，1）。选择
环
"循环",
直到ActiveCell.Row>lastrow为止
如果ActiveCell.Value=“已解决”，则“此处！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！
wb=ActiveWorkbook.Name
wb=替换（wb、.xlsx、“”）
ActiveCell.EntireRow.Cut
工作簿（“merge.xlsb的副本”）。激活
“找到匹配的公司
范围（“E1”）。选择
而ActiveCell.Value“CoName”
ActiveCell.Offset（0，1）。选择
温德
直到ActiveCell.Value=wb为止
ActiveCell.Offset（1，0）。选择
如果ActiveCell.Value=”“，则
ActiveCell.EntireRow.Select
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，skipblank:=False，转置：=False
如果结束
环
'行中的第一个单元格选择
ActiveSheet.Cells（ActiveCell.Row，1）。选择
'查找匹配的ws
如果ws=“变得更聪明”，那么
直到ActiveCell.Value=“BW”为止
ActiveCell.Offset（1，0）。选择
环
ElseIf ws=“保险更明智”则
直到ActiveCell.Value=“IW”为止
ActiveCell.Offset（1，0）。选择
环
ElseIf ws=“呼叫智者”则
直到ActiveCell.Value=“CW”为止
ActiveCell.Offset（1，0）。选择
环
ElseIf ws=“Quote Wiser”则
直到ActiveCell.Value=“QW”为止
ActiveCell.Offset（1，0）。选择
环
ElseIf ws=“做更明智的生意”然后
直到ActiveCell.Value=“BWB”为止
ActiveCell.Offset（1，0）。选择
环
ElseIf ws=“更年轻但更聪明”然后
直到ActiveCell.Value=“YBW”为止
ActiveCell.Offset（1，0）。选择
环
如果结束
'插入行并粘贴
选择。插入Shift:=xlDown，CopyOrigin:=xlFormatFromLeftOrAbove
'lastrow=Range（“A”&Rows.Count）。End（xlUp）。Row+1
'范围（“A”&最后一行）。选择
'ActiveSheet.Paste
ws.Activate
lastrow=范围（“A”和Rows.Count）.End（xlUp）.Row
单元格。选择
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add键：=范围（“A2:A19”_
)，SortOn:=xlSortOnValues，顺序：=xlAscending，数据选项：=xlSortNormal
使用ActiveWorkbook.ActiveSheet.Sort
.SetRange范围（“A1:U”和lastrow）
.Header=xlYes
.MatchCase=False
.方向=xlTopToBottom
.SortMethod=xl拼音
.申请
以
范围（“M1”）。选择
直到ActiveCell.Value=“Status”或ActiveCell.Column>100为止
ActiveCell.Offset（0，1）。选择
环
其他的
ActiveCell.Offset（1，0）。选择
如果结束
环
在那里：
”“在这儿
flastrow=工作簿（“merge.xlsb的副本”）。工作表（“合并”）。范围（“A”和行数。计数）。结束（xlUp）。行
如果blastrow=flastrow，则
工作簿（“merge.xlsb的副本”）。工作表（“合并”）。激活
范围（“A”和blastrow）。选择
ActiveCell.EntireRow.Delete
工作簿（wb）.工作表（wsName）.激活
如果结束
下一个ws
工作簿（wb）。关闭False
如果结束
file=Dir
温德
调用存储文件名
Application.ScreenUpdating=True
Application.DisplayAlerts=True
端接头

如前所述，您确实应该重写此代码，但作为一个快速解决方案，请添加一个范围变量：

Dim rgCut as Excel.Range

然后，与此相反：

ActiveCell.EntireRow.Cut

使用：

然后替换这个：

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

为此：

rgCut.Cut Destination:=Selection.Cells(1)

如前所述，您确实应该重写此代码，但作为一个快速解决方案，请添加一个范围变量：

Dim rgCut as Excel.Range

然后，与此相反：

ActiveCell.EntireRow.Cut

使用：

然后替换这个：

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

为此：

rgCut.Cut Destination:=Selection.Cells(1)

不能剪切和粘贴值。如果剪切，则只能粘贴整个范围（包括格式）。我已将其更改为“粘贴全部”，但仍然无法工作，我会记住这一点。抱歉，我不清楚。您不能使用

PasteSpecial

，您必须使用

Paste

（工作表方法，而不是范围）或Cut方法的

Destination

参数。啊，我明白了。那你建议我怎么贴？我现在已经拆下了有故障的线路并更换了