如何修改代码以便不覆盖文件?

时间:2018-03-10 21:28:44

标签: vba

在我的团队工作中,我们有6个人,我们的团队负责人分配工作。他在名为zMaster.xlsm的工作表中输入了以下标题的详细信息。

项目数量价格总发票团队Mbr Date Alloc A1 22 $ 44.21 $ 972.62 AD14256 Raghu
A2 10 $ 210.44 $ 2104.40 AD14257 Ravi
A3 22 $ 10.00 $ 220.00 AD14258 Raghu

早上他点击一个按钮可能有数百行,并且在名为Raghu.xlsx的同一文件夹中创建了以下表格

项目数量价格总发票团队Mbr Date Alloc A1 22 $ 44.21 $ 972.62 AD14256 Raghu
A3 22 $ 10.00 $ 220.00 AD14258 Raghu

这个名字叫做Ravi.xlsx

项目数量价格总发票团队Mbr Date Alloc A2 10 $ 210.44 $ 2104.40 AD14257 Ravi

我找到了执行此操作的代码。

我需要稍加修改才能让它适合我。

代码还应在“Date Alloc”字段中输入日期。

如果再次运行代码,则覆盖文件名(如果存在)。

我不会覆盖文件。我希望将新工作添加到每个团队成员文件的下一个空行中。我找到的代码来自网页

How to create a new Workbook for each unique value in a column?

我只修改了一行代码,以便不在名称的末尾附加日期戳。

谢谢大家

此致

Raghu

1 个答案:

答案 0 :(得分:0)

即使我是vba的初学者,但是这里有一个关于如何测试工作簿存在并避免覆盖的想法,也许你需要根据你的需要添加必要的循环。

Sub WorkbookExistance()
Dim pathFilename As String
pathFilename = "C:\Users\XXXXX\Desktop\Raghu.xls"

'if the workbook exists
If Dir(pathFilename) <> "" Then
    'open the workbook
    Workbooks.Open fileName:=pathFilename
    'get the filename from the full path
    GetFileName = Right(pathFilename, Len(pathFilename) - InStrRev(pathFilename, "\"))
    'activate the workbook
    Workbooks(GetFileName).Activate
    'get the last non empty row in the sheet to avoid the overwritting
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row

'if the workbook doesn't exist
Else
    Dim wb As Workbook
    ' add the workbook
    Set wb = Workbooks.Add
    ' and save it
    wb.SaveAs fileName:=pathFilename
End If End Sub