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

VBA ¼Æ­ÓExcelªº¤À­¶¡A¥þ³¡¾ã¦X¨ì¤@­ÓExcel

VBA ¼Æ­ÓExcelªº¤À­¶¡A¥þ³¡¾ã¦X¨ì¤@­ÓExcel

¥Ø«e¤u§@¤W¸I¨ì¤@­ÓÃøÃD
¥D­n¬O¥i¯à¦³¤­¤Q´X­ÓExcelªºÀÉ®×
¨C­ÓExcel¤º°²³]¦³¦h­Ósheet¡Asheet¤º¥i¯à¦³¹Ï¤ù¡A¥i¯à¦³¹Ï§Î©Î¤å¦r¤§Ãþªº

¦p¦ó¹B¥ÎVBAªº¤è¦¡
±N¨C­ÓExcel¤ºªº¤À­¶¡A¥þ³¡½Æ»s¨ì¤@­Óallªºexcel
·íµM¨C­Ó¤À­¶¬O¿W¥ßªº
¤]´N¬O°²­Y¦³50­ÓExcel¡A¨C­ÓExcel¦³3­ÓSheet
«hallªºexcel¤º±N·|¦³150­Ósheet!!

·Q½Ð°ÝªO¤Wªº°ª¤â¬O§_¥i¥HÀ°¦£¸Ñ¨M
thank you!

DEAR SIR
±NALL EXCEL ¸m©ó C:\AAA¸ê®Æ§¨¤º
°õ¦æ¦p¤U ´N¥i ALL EXCEL ¦Û°ÊÂà´« ¦Ü³æ¤@EXCEL¤¤  ¸Õ¸Õ

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
    'On Error Resume Next
    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
ù

TOP

        ÀR«ä¦Û¦b : ¥¬¬I¦p¼½ºØ¡A¥HÅw³ß¤ß´þ¼íºØ¤l¡A¤~·|µoªÞ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD