- ©«¤l
- 913
- ¥DÃD
- 150
- ºëµØ
- 0
- ¿n¤À
- 1089
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- office 2019
- ¾\ŪÅv
- 50
- ©Ê§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)
- Sub 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
½Æ»s¥N½X |
|