| ©«¤l913 ¥DÃD150 ºëµØ0 ¿n¤À1089 ÂI¦W0  §@·~¨t²Îwin10 ³nÅ骩¥»office 2019 ¾\ŪÅv50 ©Ê§O¤k µù¥U®É¶¡2011-8-28 ³Ì«áµn¿ý2023-7-19 
  
 | 
                
| ¥»©«³Ì«á¥Ñ PJChen ©ó 2021-7-4 13:36 ½s¿è 
 ¤j¤j̦n,
 With Sh
 Sh.Activate
 For j = 6 To xrow Step 2
 .Range("X" & j + 1 + 1).Resize(1, 16).Copy
 xW.Sheets("½LÂI").Range("BO" & 1 + j).Resize(1, 16).PasteSpecial xlPasteValues
 Next
 End With
 ½LÂI¤u§@ªí±qAÄæªº¦U«È¤áÀÉ®×§â¬ÛÀ³ªº½LÂI¸ê®Æ,copy¹L¨Ó
 E4¬O«ü©w¤é´Á
 AÄæ¬O«È¤á¦W
 ·íDIÄæ= D+0«h±q«È¤áÀɮתº¼Æ¦r¤u§@ªí§äE4-1ªº¤u§@ªí
 ex:E4=7/3,«h§ä"2"¤u§@ªí
 ±Nx:amªº½LÂI¸ê®Æ,¦³®w¦sªº¼Æ¦r,¹ïÀ³¤é´Á¬Û²Å,¶K¨ì½LÂI¤u§@ªíªºBH:CFªºÄæ¦ì¤¤
 
 ¨Ó·½¦U«È¤áªºÀɮ׮榡¤£·|§¹¥þ¬Û¦P,¦ý³£¬OÃþ¦üªº,¥u¥H¤@©w§@½d¥»,
 ½LÂI¤u§@ªí¤¤¦³«Ü¦hªº¤½¦¡,©Ò¥H¶K¤Wªº¸ê®Æ¤£¯à¤zÂZ¨ä¥LÀx¦s®æ,
 ½Ð°Ý(¬õ¦r)¹ïÀ³¤é´Á¶K¤W½LÂI¼ÆÈªº³o¬qµ{¦¡¸Ó«ç»ò¼g?
  ¶K½LÂI¸ê®Æ.rar (328.03 KB) ½Æ»s¥N½XSub copy_»e¸Á½LÂI()
Dim PH$, FN$, W As Workbook, xW As Workbook, xD As Worksheet, xS As Worksheet, Sh As Worksheet, i As String, rng As Range
Set xD = ThisWorkbook.Sheets("VBA")  'µ{¦¡¨Ó·½
k = xD.[V1] - 1 '¨ú«e¤@¤é
i = Format(k, "D")
y = Format(k, "yyyy")
m = Format(k, "m")
'---------------------
Set xW = Workbooks("¦h«È¤á½LÂIªí")
PH = xD.[BB1]
'---------------------
FN = Dir(PH & "*»e¸Á*" & y & "*" & m & ".xlsx")
Do While FN <> ""
On Error Resume Next: Set W = Workbooks(FN): On Error GoTo 0
If W Is Nothing Then Set W = Workbooks.Open(PH & FN)
Set Sh = W.Sheets(i)
With Sh
    xrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row + 5
End With
     xW.Sheets("½LÂI").Range("M6:M" & xrow) = Sh.Range("T7:T" & xrow).Value '¨Ó·½ «e¤éµ²¾l   
With Sh
    Sh.Activate
        For j = 6 To xrow Step 2
            .Range("X" & j + 1 + 1).Resize(1, 16).Copy
            xW.Sheets("½LÂI").Range("BO" & 1 + j).Resize(1, 16).PasteSpecial xlPasteValues
        Next
    End With
    
FN = Dir
Loop
End Sub
 | 
 |