------------------------------------------------------------------------------------
Sub 多表合并()
Dim w As Workbook
For Each i In Range("a1:a130")
c = i.Address
k = i.Value
m = Dir(ThisWorkbook.Path & "\" & k & ".xls*")
j = j + 1
Set w = GetObject(ThisWorkbook.Path & "\" & m)
With w
.Sheets(1).Range("b2:b16").Copy
ThisWorkbook.Sheets(1).Range("b" & j).PasteSpecial 12, , , True
.Close
End With
Next
End Sub
----------------------------------------------------------------------------------
Sub 批量导入图片()
For Each Shap In Sheet1.Shapes
If Shap.Type <> 8 Then Shap.Delete
Next Shap
For Each Rng In Range("a1:a130")
On Error Resume Next
i = ThisWorkbook.Path & "\" & Rng & " (1).jpg"
Set rngs = Cells(Rng.Row, 2)
Sheet1.Shapes.AddPicture i, True, True, rngs.Left, rngs.Top, rngs.Width, rngs.Height
Selection.Placement = xlMoveAndSize
Next Rng
End Sub
---------------------------------------------------------------------------------------
Selection.Placement = xlMoveAndSize (大小和位置随单元格而变)
Selection.Placement = xlMove (大小固定，位置随单元格而变)
Selection.Placement = xlFreeFloating (大小和位置固定)
-------------------------------------------------------------------------------------------
多工作簿合并(1)
Sub mergeeveryonexls() '将多个工作簿下的工作表依次对应合并到本工作簿下的工作表，即第一张工作表对应合并到第一张，第二张对应合并到第二张……
On Error Resume Next
Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet
