Vba抵消新表

我想我错过了什么,我怎么能写输出到一个新的工作表?

Set rng1 = Worksheets("blad1").Range("B8", Worksheets("blad1").Range("B" & Rows.Count).End(xlUp)) Set rng2 = Worksheets("blad2").Range("B1", Worksheets("blad2").Range("B" & Rows.Count).End(xlUp)) For Each c In rng1 If Application.WorksheetFunction.CountIf(rng1, c) > 0 Then RowNo = Application.WorksheetFunction.Match(c, rng2) c.Offset(45, 0).Resize(1, 2).Value = Worksheets("blad2").Range("B" & RowNo, "C" & RowNo).Value End If Next c 

未经testing:

 Dim b1 As Worksheet, b2 As Worksheet, b3 As Worksheet, m Set b1 = Worksheets("blad1") Set b2 = Worksheets("blad2") Set b3 = Worksheets("blad3") Set rng1 = b1.Range(b1.Range("B8"), b1.Range("B" & Rows.Count).End(xlUp)) Set rng2 = b2.Range(b2.Range("B1"), b2.Range("B" & Rows.Count).End(xlUp)) Set rng3 = b3.Range("A1") For Each c In rng1 m = Application.Match(c.Value, rng2) 'no "WorksheetFunction" 'm will be an error value if no match found If Not IsError(m) Then rng3.resize(1,2).Value = b2.Cells(RowNo, "B").Resize(1,2).Value Set rng3 = rng3.Offset(1, 0) End If Next c