ç¨vbaå¯ä»¥å®ç°ãä¸é¢è¿ä¸ªç¨åºæ¯è¯»åå½å
æ件夹ä¸ææçexcelå·¥ä½ç°¿ï¼å°æ¯ä¸ªå·¥ä½ç°¿ä¸ç第ä¸å¼ 表å¤å¶åç²è´´å°å½åå·¥ä½ç°¿çä¸ä¸ªæ±æ»è¡¨æ ¼ä¸ã代ç å¦ä¸ï¼
Sub å并()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Application.DisplayAlerts = False
Application.CutCopyMode = False
'MYP = "å¾
读åæ件"
myw = ActiveWorkbook.Name
Dim FILENAME As String
Dim mypath As String
Dim ZZ As Long
Sheets("åå§æ°æ®å并").Range("a1:zz1000000").Clear
'mypath = ThisWorkbook.Path & "\" & MYP
mypath = ThisWorkbook.Path
ZZ = 1: XH = 0 'ZZ-åå
¥çä½ç½® xh-åºå·
MYFILE = Dir(mypath & "\" & "*.xls*")
Do While MYFILE <> ""
If MYFILE = "" Then
Exit Do 'å½MyFile为空çæ¶å就说æå·²ç»éåå®äºï¼è¿æ¶éåºDoï¼å¦åè¿è¦è¿è¡ä¸é
End If
If InStr(MYFILE, "ç¼ç å并") = 0 Then
XH = XH + 1
Set mybook = Application.Workbooks.Open(mypath & "\" & MYFILE)
Set mysheet = mybook.Sheets(1)
With mysheet
HH = .Cells(100000, 1).End(xlUp).Row
Range(.Cells(1, 1), .Cells(HH, 100)).Select
Selection.Copy
End With
Windows(myw).Activate
Sheets("åå§æ°æ®å并").Select
Range("B" & ZZ).Select
ActiveSheet.Paste
Range(Cells(ZZ, 1), Cells(ZZ + HH - 1, 1)).Formula = XH
ZZ = ZZ + HH
mybook.Close
End If
MYFILE = Dir '第äºæ¬¡è¯»å
¥çæ¶åä¸ç¨ååæ°
Loop
Cells(1, 1) = "ç¼å·"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub