Hsieh

¦^´_ 2# PJChen

¶K¤Wªº¦ì¸m¬O®w¦sÀɮתº¦ì¸m¡A­Y­ì¨Ó®w¦sªºµ§¼Æ¤£¦P¸Ó¦p¦ó³B²z?
­Yµ§¼Æ¬Û¦P´N·|ª½±µÂл\­ì¦³¸ê®Æ¡A³o¬O§Aªº»Ý¨D¶Ü?
­Yµ§¼Æ±Ð­û¸ê®Æ¦h¡A«h·|¼vÅT¤£¦P·Ç«hªº¸ê®Æ¡A³o¨Ç¸ò®w¦sÆ[©À¦n¹³³£¤£²Å¦X

Hsieh

¦^´_ 4# PJChen

°Ñ¦Ò¬Ý¬Ý

1. Sub copy_all()
   
2. Dim ws() '¤w¸g¶}±Òµøµ¡
   
3. books = Array("®w¦s¸ê®Æªí.xlsx", "®w¦s.xlsx") '±ý¶}±ÒÀÉ®×
   
4. mypath = ThisWorkbook.Path '¦s©ñÀɮ׸ê®Æ§¨
   
5. For Each w In Windows '¤w¸g¶}±Òµøµ¡
   
6.    ReDim Preserve ws(s)
   
7.    ws(s) = w.Caption
   
8.    s = s + 1
   
9. Next
   
10. For Each b In books '´ú¸ÕÀɮ׬O§_¶}±Ò
    
11.    If UBound(Filter(ws, b)) = -1 Then Workbooks.Open (mypath & "\" & b) 'ÀÉ®×¥¼¶}±Ò«h¶}±Ò
    
12. Next
    
13. x = ThisWorkbook.Sheets(1).[H2] '·Ç«h
    
14. With Workbooks(books(0)) '®w¦s¸ê®Æªí.xlsx
    
15.     Set a = .Sheets(1).Columns("D").Find(x, lookat:=xlWhole) '§ä·Ç«h¦ì¸m
    
16.     If a Is Nothing Then MsgBox "§ä¤£¨ì·Ç«h¦ì¸m": End
    
17.     k = Application.CountIf(a.EntireColumn, x) '¦X¥G·Ç«h¦C¼Æ
    
18.     Set Rng = .Sheets(1).Cells(a.Row, "B").Resize(k, 26) 'B:AAÄæ¸ê®Æ
    
19.     With Workbooks(books(1)) '®w¦s.xlsx
    
20.        k1 = Application.CountIf(.Sheets(1).Columns("D"), x) '¦X¥G·Ç«h¦C¼Æ
    
21.        Set a = .Sheets(1).Columns("D").Find(x, lookat:=xlWhole) '§ä·Ç«h¦ì¸m
    
22.        If a Is Nothing Then Set a = .Sheets(1).Cells(.Sheets(1).Rows.Count, 4).End(xlUp).Offset(1) '­ì¸ê®Æ¤£¦s¦b·Ç«h¸ê®Æ
    
23.        yn = MsgBox("­ì¸ê®Æ" & k1 & "¦C¡A·s¸ê®Æ" & k & "¦C¡A¬O§_½Æ»s?", vbYesNo)
    
24.        If yn = 6 Then
    
25.           a.Offset(, -2).Resize(k, 26).Value = Rng.Value '¼g¤J·s¸ê®Æ
    
26.           MsgBox "¸ê®Æ¤w§ó·s"
    
27.         Else
    
28.           MsgBox "¸ê®Æ¥¼§ó·s", 48
    
29.        End If
    
30.     End With
    
31. End With
    
32. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 6# PJChen

1. Sub copy_all()
   
2. Dim ws() '¤w¸g¶}±Òµøµ¡
   
3. books = Array("®w¦s¸ê®Æªí.xlsx", "®w¦s.xlsx") '±ý¶}±ÒÀÉ®×
   
4. mypath = ThisWorkbook.Path '¦s©ñÀɮ׸ê®Æ§¨
   
5. For Each w In Windows '¤w¸g¶}±Òµøµ¡
   
6.    ReDim Preserve ws(s)
   
7.    ws(s) = w.Caption
   
8.    s = s + 1
   
9. Next
   
10. For Each b In books '´ú¸ÕÀɮ׬O§_¶}±Ò
    
11.    If UBound(Filter(ws, b)) = -1 Then Workbooks.Open (mypath & "\" & b) 'ÀÉ®×¥¼¶}±Ò«h¶}±Ò
    
12. Next
    
13. x = ThisWorkbook.Sheets(1).[H2] '·Ç«h
    
14. With Workbooks(books(0)).Sheets(1) '®w¦s¸ê®Æªí.xlsx
    
15.     Set a = .Columns("D").Find(x, lookat:=xlWhole) '§ä·Ç«h¦ì¸m
    
16.     If a Is Nothing Then MsgBox "§ä¤£¨ì·Ç«h¦ì¸m": End
    
17.     Set Rng = .Range(a.Offset(, -2), a.End(xlDown).Offset(, 23)) 'B:AAÄæ¸ê®Æ
    
18.     MsgBox Rng.Address
    
19.     With Workbooks(books(1)).Sheets(1) '®w¦s.xlsx
    
20.        Set a = .Columns("D").Find(x, lookat:=xlWhole) '§ä·Ç«h¦ì¸m
    
21.        If a Is Nothing Then Set a = .Cells(.Rows.Count, 4).End(xlUp).Offset(1) '­ì¸ê®Æ¤£¦s¦b·Ç«h¸ê®Æ
    
22.        .Range("A" & a.Row & ":AA" & .Rows.Count).ClearContents
    
23.           a.Offset(, -2).Resize(Rng.Rows.Count, 26).Value = Rng.Value '¼g¤J·s¸ê®Æ
    
24.           a.Offset(, -3).Resize(Rng.Rows.Count, 1) = Rng.Columns(5).Value '¼g¤JAÄæ½s¸¹
    
25.           MsgBox "¸ê®Æ¤w§ó·s"
    
26.     End With
    
27. End With
    
28. End Sub

½Æ»s¥N½X