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

[µo°Ý] ½Ð±Ð¤£¦P¬¡­¶Ã¯¶¡ªº¤u§@ªí½Æ»s

[µo°Ý] ½Ð±Ð¤£¦P¬¡­¶Ã¯¶¡ªº¤u§@ªí½Æ»s

  1. Sub ³øªí()

  2.     Dim Wb As Workbook
  3.     Dim Thesou As String
  4.     Application.ScreenUpdating = False
  5.     Thesou = ThisWorkbook.Path & "\³øªí½d¥».xlsx"
  6.     Set Wb = GetObject(Thesou)
  7.     Dim X As Integer
  8.      X = 2
  9.     Do
  10.         Wb.Sheets(1).Copy after:=ThisWorkbook.Sheets(Sheets.Count)
  11.         ActiveSheet.Name = Sheets("Shall").Cells(X, 1) & Sheets("Shall").Cells(X, 2)
  12.         X = X + 1
  13.     Loop Until Sheets("Shall").Cells(X, 1) = "" Or Sheets("Shall").Cells(X, 2) = ""
  14.     Wb.Close False
  15.     Set Wb = Nothing
  16.     Application.ScreenUpdating = True

  17. End Sub
½Æ»s¥N½X

¦b¬¡­¶Ã¯Á`³øªí.xlsxªºShall¤u§@ªí¡AÄæA©MÄæB¤À§O¬O°Ó«~½s¸¹©M°Ó«~¦WºÙ¡A
­n§â¦P¸ê®Æ§¨¬¡­¶Ã¯³øªí½d¥».xlsxªºSheets(1)½Æ»s¦^¬¡­¶Ã¯Á`³øªí.xlsx¡A
¨Ã¤À§O«Ø¥ß¦WºÙ¬°°Ó«~½s¸¹+°Ó«~¦WºÙªºn­Ó¤u§@ªí
¦]§Ú¬O¤jµæ³¾¡A©Ò¥Hµ{¦¡½X¤S¯ä¤Sªø¡A¥Ø«e¥u¯à¤ÏÂнƻs³øªí½d¥».xlsxªºSheets(1)¤u§@ªí¶K¦^Á`³øªí.xlsx
Àµ½Ð°ª¤â­Ì½ç±Ð§ó¦³®Ä²vªº¼gªk¡A·P¿E¤£ºÉ¡IÁÂÁ¡I

¥»©«³Ì«á¥Ñ luhpro ©ó 2013-11-15 22:30 ½s¿è

¦^´_ 1# oao
¥H¤Uµ{¦¡¤£¥i­«½Æ°õ¦æ(·|µo¥Í SheetName ­«½Æªº¿ù»~), ³o¸Ì¨S¦³³]©w«ö¶s©ÎIJµo¦¹µ{§Çªº¾÷¨î, «Øij¥H³æ³¡°õ¦æ¨ÓÆ[¹î¹B§@±¡§Î.
  1. Sub CrtSheet()
  2.   Dim lRow&
  3.   Dim sStr$
  4.   Dim rSou As Range, rTar As Range

  5.   With Workbooks.Open(ThisWorkbook.Path & "\³øªí½d¥».xls")
  6.     Set rSou = .Sheets("Sheet1").[A1] ' ¨Ó·½
  7.   End With
  8.   Set rTar = ThisWorkbook.Sheets("Sheet1").[A1] ' ¥Øªº
  9.   
  10.   With rTar.Parent ' ¥u Copy 1 ­Ó Sheet, ¤§«á§ï¥H¦¹ Sheet °µ¥Àª©
  11.     lRow = 2
  12.     sStr = .Cells(lRow, 1) & "-" & .Cells(lRow, 2)
  13.     rSou.Parent.Cells.Copy
  14.     .Activate
  15.     With ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
  16.       With .[A1]
  17.         .PasteSpecial
  18.         .Select ' ÁקK¾ã­Ó Sheet ³Q Select ªº±¡§Î
  19.       End With
  20.       .Name = sStr ' §ï¦W
  21.     End With
  22. Application.DisplayAlerts = False ' Ãö±¼¨t²Î½T»{¬O§_©ñ±ó¤j¶q½Æ»s¸ê®Æªº¸ß°Ý°T®§
  23.     rSou.Parent.Parent.Close False ' Ãö³¬½d¨ÒÀÉ®×
  24. Application.DisplayAlerts = True
  25.   
  26.     Set rSou = Sheets(sStr).[A1] ' ²£¥Í¨ä¥L Sheet
  27.     lRow = 3
  28.     Do While .Cells(lRow, 1) <> ""
  29.       sStr = .Cells(lRow, 1) & "-" & .Cells(lRow, 2)
  30.       rSou.Parent.Cells.Copy
  31.       .Activate
  32.       With ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
  33.         With .[A1]
  34.           .PasteSpecial
  35.           .Select
  36.         End With
  37.         .Name = sStr
  38.       End With
  39.       lRow = lRow + 1
  40.     Loop
  41.   End With
  42. End Sub
½Æ»s¥N½X
¤£¦P¬¡­¶Ã¯¶¡ªº¤u§@ªí½Æ»s.zip (9.15 KB)
' ¥H¤U¬O§Úªº¨Ï¥Î Excel VBA ´X¦~«áªºÆ[ÂI : (¥u¨Ï¥Î¹L Excel 2000 »P Excel 2003)
' Excel VBA ¤¤¥u¯à Dim Range ¤£¯à Dim Sheet (¹ïÀ³³æ¤@ Sheet, ¥B¾A¥Î¥ô¤@ Sheet), ¥u¯à Dim WorkSheet
' ³o¸Ì¤£±Ä¥Î WorkSheet, ¦]¬°Worksheet ¥u¯à¹ïÀ³¨ì¥Ø«eªº Sheet(Active ªº), ¤£½×§A¬A©·¤º©ñ¤°»òSheetName, ¬Æ¦Ü¨Æ¥ý Set ¹Lªº, ¥Î®É³£¬O«ü¦V¦P¤@­Ó Sheet
' ¤]¤£±Ä¥Î Sheetx , ¦]¬°¤£½×¬O Sheet1, Sheet2, Sheet3... ³£«ÜÃø¥Î, Sheet1 ¥u¯à¥Î¦b Sheets(1), ¥Î¦b¨ä¥L Sheet ´N·|µo¥Í¿ù»~
' ©Ò¥H§Ú§ï¥Î Range.Parent ¨Ó«ü¦V¯S©wªº Sheet (¦n³B¬O¥u­n¤£¬O¥Î Work¬ÛÃö«ü¥O<WorkSheet...> ©Î¬O Select ´N¤£¥Î¨Æ¥ý Activate, ·Ó¼Ë¹ïÀ³¨ì¨Æ¥ý©w¸q¦nªº Sheet)

TOP

¦^´_ 2# sunnyso
A.rar (17.01 KB)
ªþ¤Wªþ¥ó¡AÁٽнç±Ð¡AÁÂÁ¡I

TOP

¦^´_ 3# luhpro
·PÁ«ü¾É¡A§Ú¥ý¤U¸ü¤j¤jªºªþ¥ó°Ñ¦Ò¡A«D±`ÁÂÁ¡I

TOP

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2013-11-16 00:00 ½s¿è

¦^´_ 1# oao
¸Õ¸Õ¦³¨S¦³¤ñ¸û§Ö
  1. Sub ³øªí()
  2.     Dim x As Long
  3.     Dim Thesou As String
  4.     Thesou = ThisWorkbook.Path & "\³øªí½d¥».xlsx"   '½d¥»¥u§t¤@­Ó¤u§@ªí
  5.         
  6.     Application.ScreenUpdating = False
  7.     With Sheets("Shall")
  8.         For x = .[A1].End(xlDown).Row To 2 Step -1
  9.             Sheets.Add(After:=Sheets(1), Type:=Thesou).Name = .Cells(x, 1) & .Cells(x, 2)
  10.         Next
  11.     End With
  12.     Application.ScreenUpdating = True
  13. End Sub
½Æ»s¥N½X

TOP

¦^´_ 6# stillfish00
¦b Type:=Thesou ³B·|µo¥Í¿ù»~.

°Ñ·Ó 6# ¤S§ï¥X¨âºØ¤è¦¡ :
  1. Sub ³øªí()
  2.     Dim x As Long
  3.     Dim wsSou As Worksheet
  4.     Dim Thesou As String
  5.     Set wsSou = Workbooks.Open(ThisWorkbook.Path & "\³øªí½d¥».xls").Sheets(1)   '½d¥»¥u§t¤@­Ó¤u§@ªí
  6.         
  7.     Application.ScreenUpdating = False
  8.     With ThisWorkbook.Sheets("Sheet1")
  9.         For x = .[A1].End(xlDown).Row To 2 Step -1
  10.             wsSou.Copy After:=.[A1].Parent
  11.              ActiveSheet.Name = .Cells(x, 1) & .Cells(x, 2)
  12.         Next
  13.     End With
  14.     Application.ScreenUpdating = True
  15. End Sub
½Æ»s¥N½X
  1. Sub ³øªí2()
  2.     Dim x As Long
  3.     Dim rSou As Range, rTar As Range
  4.     Dim Thesou As String
  5.     Set rTar = ThisWorkbook.Sheets("Sheet1").[A1]
  6.     Set rSou = Workbooks.Open(ThisWorkbook.Path & "\³øªí½d¥».xls").Sheets("Sheet1").[A1]   '½d¥»¥u§t¤@­Ó¤u§@ªí
  7.         
  8.     Application.ScreenUpdating = False
  9.     With rTar.Parent
  10.         For x = .[A1].End(xlDown).Row To 2 Step -1
  11.             rSou.Parent.Copy After:=.Parent.Sheets(1)
  12.             ActiveSheet.Name = .Cells(x, 1) & .Cells(x, 2)
  13.         Next
  14.     End With
  15.     Application.ScreenUpdating = True
  16. End Sub
½Æ»s¥N½X

TOP

¦b Type:=Thesou ³B·|µo¥Í¿ù»~.
luhpro µoªí©ó 2013-11-16 07:15


Excel2003 ½d¥»¥t¦s·sÀɬ° "³øªí½d¥».xlt" ¬Ý¬Ý

TOP

¦^´_ 8# stillfish00
«Ü·PÁ¡A´ú¸Õ«á³t«×§Ö¦h¤F¡AÁÂÁÂstillfish00¤j±Ð¤F¦b¤UÄ_¶Qªº¤@½Ò¡A·P®¦¡I

TOP

        ÀR«ä¦Û¦b : ¦Y­W¤F­W¡B­WºÉ¤Ü¨Ó¡A¨ÉºÖ¤FºÖ¡BºÖºÉ´d¨Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD