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

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
参数。啊,我明白了。那你建议我怎么贴?我现在已经拆下了有故障的线路并更换了