|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 导入出入库数据()
Application.ScreenUpdating = False
Dim rn As Range
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "*.xls*")
Do While f <> ""
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(lj & f, 0)
If InStr(wb.Name, "出库") > 0 Then
Set sht = ThisWorkbook.Worksheets("出库")
With wb.Worksheets(1)
If sht.[a1] = "" Then
Set rn = .[a1].CurrentRegion
Else
Set rn = .[a1].CurrentRegion.Offset(1)
End If
End With
r = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
If r = 2 Then r = 1
rn.Copy sht.Cells(r, 1)
Set rn = Nothing
ElseIf InStr(wb.Name, "入库") > 0 Then
Set sht = ThisWorkbook.Worksheets("入库")
With wb.Worksheets(1)
If sht.[a1] = "" Then
Set rn = .[a1].CurrentRegion
Else
Set rn = .[a1].CurrentRegion.Offset(1)
End If
End With
r = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
If r = 2 Then r = 1
rn.Copy sht.Cells(r, 1)
Set rn = Nothing
End If
wb.Close False
End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|