- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¦^´_ 1# rouber590324
¸Õ¸Õ¬Ý- Option Explicit
- Sub Ex()
- Dim P As String, F As String, Rng As Range, Sh As Worksheet, Sh_Name As String
- P = "C:\AAA\"
- F = Dir(P & "*.xls")
- If F = "" Then Exit Sub
- Sh_Name = ","
- Set Rng = Workbooks.Add(1).Sheets(1).[A1] '·s¼W¬¡¶Ã¯(¤@±i¤u§@ªí): ³]¸m¥ØªºÀx¦s®æ
- Application.ScreenUpdating = False
- Do While F <> ""
- With Workbooks.Open(P & F)
- For Each Sh In .Worksheets
- '¤u§@ªí¦WºÙ¬Û¦P (©Î) ªÅ¥Õ¤u§@ªí,¤£¤©COPY
- If InStr(Sh_Name, "," & Sh.Name & ",") = 0 Then '¤u§@ªí¦WºÙ¤£¬Û¦P
- Sh_Name = Sh_Name & Sh.Name & "," '·s¼W¤u§@ªí¦WºÙ
- If WorksheetFunction.CountA(Sh.UsedRange.Columns(1)) > 0 Then '¤£¬OªÅ¥Õ¤u§@ªí
- Sh.UsedRange.Copy Rng '¸ê®Æ½Æ»s¨ì¥ØªºÀx¦s®æ
- '¥ØªºÀx¦s®æ«¸m******
- If Rng.End(xlDown).Row = Rows.Count Then
- Set Rng = Rng.Offset(1) '¤U²¾¤@¦C
- Else
- Set Rng = Rng.End(xlDown).Offset(1) '¤U²¾¨ì³Ì«á¦³¸ê®Æªº¤@¦C
- End If
- '*********************
- End If
- End If
- Next
- .Close False
- End With
- F = Dir
- Loop
- Rng.Parent.SaveAs "D:\¸ê®Æ®w.XLS" '¸ê®Æ·J¾ã¦P¤@ EXCEL«á¦sÀÉ
- Application.ScreenUpdating = True
- End Sub
½Æ»s¥N½X |
|