Sub yy() Dim shp As Shape With Sheets("sheet2") i = .Range("b65536").End(xlUp).Offset(1).Row .Range("b" & i) = Sheets("sheet1").Range("d9") .Range("c" & i) = Sheets("sheet1").Range("k9") col = .Range("iv2").End(xlToLeft).Column For j = 4 To col Step 2 For Each shp In Sheets("sheet1").Shapes If shp.Type = 13 And Mid(shp.Name, 9) = Mid(.Cells(2, j + 1), 3) Then .Cells(i, j) = Sheets("sheet1").Range("b11:b5000").Find(.Cells(2, j + 1), , , 1).Offset(1, 6).Value shp.CopyPicture xlScreen, xlBitmap .Paste Destination:=.Cells(i, j + 1) End If Next Next End With End Sub [ 本帖最后由 office2008 于 2009-1-19 22:55 编辑 ] |
|