ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¸ê®Æ§¨¤ºALL EXCEL ·J¾ã¤è¦¡½Ð±Ð

[µo°Ý] ¸ê®Æ§¨¤ºALL EXCEL ·J¾ã¤è¦¡½Ð±Ð

DEAR ALL ¤j¤j
1.¦p¤Uµ{¦¡½X¬°«e½ú°w¹ï«ü©w¸ê®Æ§¨ALL-EXCEL¦Û°Ê·J¾ã¦ÜÁ`ªí¤è¦¡(¦h¤u§@ªí)-¤u§@ªí¦WºÙ¬Û¦P-ªÅ¥Õ¤u§@ªí¤£¤©COPY
2.½Ð±Ð«eÃD¬O  ¨C¤@  EXCEL ¤§®æ¦¡³£¬Û¦P  ¦p¦ó«ü©w¸ê®Æ§¨ALL-EXCEL¦Û°Ê·J¾ã¦ÜÁ`ªí¤è¦¡(³æ¤@EXCEL)-¤u§@ªí¦WºÙ¬Û¦P-ªÅ¥Õ¤u§@ªí¤£¤©COPY
  2.1 ´N¬O  ¸ê®Æ§¨ ALL EXCEL ¤º¤§  SHEETS ¤§®æ¦¡³£¬Û¦P.­n±N¸ê®Æ·J¾ã¦P¤@ EXCEL ¤§¦P¤@ SHEETS («Ø¥ß¸ê®Æ®wÁ`ªí)
  2.2 ·Ð¤£§[½ç±Ð   THANKS*10000   

Sub yy()
  Dim a As Workbook, f$
  Dim p$, sh As Worksheet
  Set a = ThisWorkbook
  p = "C:\AAA\"
  f = Dir(p & "*.xls")
  Application.ScreenUpdating = False
  Do While f <> ""
    Workbooks.Open p & f
    For Each sh In Worksheets
    X = WorksheetFunction.CountA(sh.Range("a1:iv65536"))
    Y = ActiveWorkbook.Name
    If X <> 0 Then
      sh.Copy after:=a.Sheets(a.Sheets.Count)
    End If
    Next
    Windows(f).Close True
    f = Dir
  Loop
  Application.ScreenUpdating = True
  Sheet1.Select
  Range("A1").Select
End Sub
ù

¦^´_ 1# rouber590324
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim P As String, F As String, Rng As Range, Sh As Worksheet, Sh_Name As String
  4.     P = "C:\AAA\"
  5.     F = Dir(P & "*.xls")
  6.     If F = "" Then Exit Sub
  7.     Sh_Name = ","
  8.     Set Rng = Workbooks.Add(1).Sheets(1).[A1]  '·s¼W¬¡­¶Ã¯(¤@±i¤u§@ªí): ³]¸m¥ØªºÀx¦s®æ
  9.     Application.ScreenUpdating = False
  10.     Do While F <> ""
  11.         With Workbooks.Open(P & F)
  12.             For Each Sh In .Worksheets
  13.                 '¤u§@ªí¦WºÙ¬Û¦P (©Î) ªÅ¥Õ¤u§@ªí,¤£¤©COPY
  14.                 If InStr(Sh_Name, "," & Sh.Name & ",") = 0 Then '¤u§@ªí¦WºÙ¤£¬Û¦P
  15.                     Sh_Name = Sh_Name & Sh.Name & ","           '·s¼W¤u§@ªí¦WºÙ
  16.                     If WorksheetFunction.CountA(Sh.UsedRange.Columns(1)) > 0 Then '¤£¬OªÅ¥Õ¤u§@ªí
  17.                         Sh.UsedRange.Copy Rng  '¸ê®Æ½Æ»s¨ì¥ØªºÀx¦s®æ
  18.                         '¥ØªºÀx¦s®æ­«¸m******
  19.                         If Rng.End(xlDown).Row = Rows.Count Then
  20.                             Set Rng = Rng.Offset(1)             '¤U²¾¤@¦C
  21.                         Else
  22.                             Set Rng = Rng.End(xlDown).Offset(1)  '¤U²¾¨ì³Ì«á¦³¸ê®Æªº¤@¦C
  23.                         End If
  24.                         '*********************
  25.                     End If
  26.                 End If
  27.             Next
  28.             .Close False
  29.         End With
  30.         F = Dir
  31.     Loop
  32.     Rng.Parent.SaveAs "D:\¸ê®Æ®w.XLS" '¸ê®Æ·J¾ã¦P¤@ EXCEL«á¦sÀÉ
  33.     Application.ScreenUpdating = True
  34. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

DEAR  GBKEE ¤j¤j
  «D±`«D±`·PÁ±z¤§«ü¾É-100%²Å¦X»Ý¨D  THANKS*10000
ù

TOP

        ÀR«ä¦Û¦b : ¦Û¤v®`¦Û¤v¡A²ö¹L©ó¶ÃµoµÊ®ð¡C
ªð¦^¦Cªí ¤W¤@¥DÃD