根据特定条件在复制和联合范围中的Vba代码中出现问题

时间:2018-01-08 08:39:27

标签: excel vba excel-vba

我的代码在突出显示的行中显示runtime error 424。可能的原因是什么?我的行没有被复制。 CopyRng12 会产生某种问题。

sub grouping()
Set ws6 = Workbooks("A.xlsx").Worksheets("X1")
Set ws7 = Workbooks("B.xlsx").Worksheets("X2")
LastRowu = ws6.Cells(Rows.Count, "B").End(xlUp).Row
LastRowb = ws7.Cells(Rows.Count, "K").End(xlUp).Row
LastRowb1 = ws7.Cells(Rows.Count, "L").End(xlUp).Row
Application.Calculation = xlAutomatic
ws6.Columns("E:E").Insert Shift:=xlToRight, 
CopyOrigin:=xlFormatFromLeftOrAbove
ws6.Range("E2").FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[B.xlsx]X2'!C11:C12,2,0)"
ws6.Range("E2").AutoFill Destination:=ws6.Range("E2:E" & LastRowu), 
Type:=xlFillDefault
With ws6.UsedRange
    .Copy
    .PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End With
ws6.Cells.Replace "#N/A", "Company Code Not Found", xlWhole
Workbooks("A.xlsx").Worksheets("X1").Activate
ws6.Columns("D:D").Select
Selection.Copy
ws6.Columns("A:A").Select
Selection.Insert Shift:=xlToRight
For q = LastRowu - 1 To 1 Step -1
    If ws6.Cells(q, "F").Value = "G1" Then
        **If Not CopyRng12 Is Nothing Then
            Set CopyRng12 = Application.Union(CopyRng12, ws6.Rows(q))**
        Else
            Set CopyRng12 = ws6.Rows(q)
        End If  
    End If
Next q
    Set wbmm = Workbooks("G1.xlsx")
    Workbooks("G1.xlsx").Activate
    Dim wsmm As Worksheet
    Set wsmm = wbmm.Worksheets("X1")
    Workbooks("G1.xlsx").Worksheets("X1").Activate
    CopyRng12.Copy
    Worksheets("X2").ClearContents
    ActiveSheet.Paste
    End Sub

0 个答案:

没有答案