·Q§âŪ¤Jªºsheet ¤JÓfile ¦A¦Û°Ê¶}¤@¶¥scombile sheets
- ©«¤l
- 19
- ¥DÃD
- 13
- ºëµØ
- 0
- ¿n¤À
- 38
- ÂI¦W
- 0
- §@·~¨t²Î
- Vista
- ³nÅ骩¥»
- OFFICE2003
- ¾\ŪÅv
- 10
- µù¥U®É¶¡
- 2013-2-20
- ³Ì«áµn¿ý
- 2013-6-25
|
·Q§âŪ¤Jªºsheet ¤JÓfile ¦A¦Û°Ê¶}¤@¶¥scombile sheets
Sub MergeBook()
Dim MyPath$, MyName$, wb As Workbook, sh As Worksheet, sht As Worksheet
Set wb = ThisWorkbook
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xls")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sh In Sheets
If sh.Name <> ActiveSheet.Name Then sh.Delete
Next
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
With GetObject(MyPath & MyName)
For Each sht In .Sheets
sht.Copy After:=wb.Sheets(wb.Sheets.Count)
Next
.Close False
End With
End If
MyName = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
§Ú·Q°µ§¹²Ä¤@Ómarco«á
¶}¤@Ó¥scombile sheets
§âcombile sheets ²¾¨ì³Ì«áªºsheets
run ¥¨¶°8
¥¨¶°8 run ¥OMergeBook()Ū¤Jexcel file ¦X¨Ö
§Ú·Q§â¨âÓmarco¦X°_¨Ó
°µ¨ì¨âÓmarco¥\¯à
Sub ¥¨¶°8()
'
' ¥¨¶°8 ¥¨¶°
'
'
mysheets = ActiveWorkbook.Sheets.Count - 4
myworksheets = ActiveWorkbook.Worksheets.Count - 4
For i = 1 To myworksheets
Sheets(i).Select
Range("A8:L30").Select
Selection.Copy
Sheets("¤u§@ªí1").Select
ActiveCell.Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Next
End Sub |
|
|
|
|
|
|