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

¸ê®Æ·JÁ`

¸ê®Æ·JÁ`

­×§ï«á¥X²{µ{¦¡¿ù»~¡A½Ð°Ý§Ú¸Ó¦p¦ó­×§ï©O¡H
¥Øªº¬O±N°V½m»Ý¨D¸Ìªº©Ò¦³ExcelÀÉsheet2¸ê®Æ·JÁ`¨ìÁ`ªí
  1. Sub ¶×Á`()
  2. Dim myfile, mypath, wkb
  3. 'Application.ScreenUpdating = False   'Ãö³¬¿Ã¹õ§ó·s
  4. Sheets("Á`ªí").UsedRange.Offset(1, 0).Clear  '²M°£ªíÀY¤§¥~ªº©Ò¦³¤º®e
  5. mypath = Sheets("³]©w­¶").Range("b9")           '§ä¨ì¥Ø«e¬¡­¶Ã¯ªº¸ô®|
  6. MsgBox (mypath)
  7. myfile = Dir(mypath & "\*.xls*")     'ÂsÄý¥Ø«e¸ê®Æ§¨¤UªºExcel¤å¥ó
  8. MsgBox (myfile)
  9. Do While myfile <> ""                '·í§ä¨ìªº¤å¥ó¤£¬°ªÅ®É
  10. If myfile <> ThisWorkbook.Name Then  '·í§ä¨ìªº¤å¥ó¤£¬O¥Ø«eExcel¬¡­¶Ã¯®É
  11. Set wkb = GetObject(mypath & "\" & myfile)   '±o¨ìdir§ä¨ìªº¬¡­¶Ã¯ªº¤º®e¡A³]¬°wkb
  12. With wkb.Sheets(2)              '¹ï§ä¨ìªº¬¡­¶Ã¯ªºsheet1¶i¦æ¾Þ§@
  13. '½Æ»swkbªºsheet1°£²Ä¤@¦Cªº©Ò¦³¤º®e
  14. .UsedRange.Offset(6, 0).Copy Sheet2.Range("A6:I25")
  15. End With
  16. wkb.Close False      'Ãö³¬wkb¬¡­¶Ã¯¥B¤£Àx¦s
  17. End If
  18. myfile = Dir         '´M§ä¤U¤@­ÓExcel¬¡­¶Ã¯
  19. Loop
  20. 'Application.ScreenUpdating = True   '«ì´_¿Ã¹õ§ó·s
  21. End Sub
½Æ»s¥N½X

111-vba - ½Æ»s.zip (324.2 KB)

        ÀR«ä¦Û¦b : ¡i°µ¤Hªº¶}©l¡j¨C¤@¤Ñ³£¬O¬G¤Hªº¶}©l¡A¨C¤@­Ó®É¨è³£¬O¦Û¤vªºÄµ±§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD