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

oao

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

oao

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

stillfish00

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

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

luhpro

¦^´_ 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

stillfish00

¦^´_ 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

oao

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

oao

¦^´_ 2# sunnyso
A.rar (17.01 KB)

²©öªþ¥ó
¤U¸ü¦¸¼Æ: 9

2013-11-15 22:58

ªþ¤Wªþ¥ó¡AÁٽнç±Ð¡AÁÂÁ¡I

luhpro

¦^´_ 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. 
   
6.   With Workbooks.Open(ThisWorkbook.Path & "\³øªí½d¥».xls")
   
7.     Set rSou = .Sheets("Sheet1").[A1] ' ¨Ó·½
   
8.   End With
   
9.   Set rTar = ThisWorkbook.Sheets("Sheet1").[A1] ' ¥Øªº
   
10.   
    
11.   With rTar.Parent ' ¥u Copy 1 ­Ó Sheet, ¤§«á§ï¥H¦¹ Sheet °µ¥Àª©
    
12.     lRow = 2
    
13.     sStr = .Cells(lRow, 1) & "-" & .Cells(lRow, 2)
    
14.     rSou.Parent.Cells.Copy
    
15.     .Activate
    
16.     With ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
    
17.       With .[A1]
    
18.         .PasteSpecial
    
19.         .Select ' ÁקK¾ã­Ó Sheet ³Q Select ªº±¡§Î
    
20.       End With
    
21.       .Name = sStr ' §ï¦W
    
22.     End With
    
23. Application.DisplayAlerts = False ' Ãö±¼¨t²Î½T»{¬O§_©ñ±ó¤j¶q½Æ»s¸ê®Æªº¸ß°Ý°T®§
    
24.     rSou.Parent.Parent.Close False ' Ãö³¬½d¨ÒÀÉ®×
    
25. Application.DisplayAlerts = True
    
26.   
    
27.     Set rSou = Sheets(sStr).[A1] ' ²£¥Í¨ä¥L Sheet
    
28.     lRow = 3
    
29.     Do While .Cells(lRow, 1) <> ""
    
30.       sStr = .Cells(lRow, 1) & "-" & .Cells(lRow, 2)
    
31.       rSou.Parent.Cells.Copy
    
32.       .Activate
    
33.       With ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
    
34.         With .[A1]
    
35.           .PasteSpecial
    
36.           .Select
    
37.         End With
    
38.         .Name = sStr
    
39.       End With
    
40.       lRow = lRow + 1
    
41.     Loop
    
42.   End With
    
43. End Sub

½Æ»s¥N½X

¤£¦P¬¡­¶Ã¯¶¡ªº¤u§@ªí½Æ»s.zip (9.15 KB)

¤U¸ü¦¸¼Æ: 8

2013-11-15 22:27

' ¥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)