Question

我曾尝试使用VBA来帮助从Excel表单中获取值到另一个工作簿（现在里面是空白的）这里是我使用的VBA代码：

Sub RunMe()
    Dim lRow, lCol As Integer

    Sheets("Sheet1").Select
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column

    For Each cell In Range(Cells(1, "B"), Cells(1, lCol))
        Union(Range("A1:A" & lRow), Range(Cells(1, cell.Column), Cells(lRow, cell.Column))).Copy
        Workbooks.Add
        Range("A1").PasteSpecial
        ActiveWorkbook.SaveAs Filename:= _
          "C:\Users\john\Desktop\Testforvba" & cell.Value & ".xls"
        ActiveWorkbook.Close
    Next cell

    Application.CutCopyMode = False
End Sub

但问题是，当我在表单上输入样本值并手动运行宏后运行此代码时，它可以正常工作，因为它创建了一个新文件并存储了我在Form工作簿上输入的样本数据。但是一旦我再次尝试运行宏，我意识到它重新创建了文件AGAIN，这意味着它将替换所有以前的数据。 VBA真是太硬了哈哈。任何人都请帮忙谢谢。

P.S我存储在个人工作簿中的宏

Answer 1

试试这个：

Option Explicit

Sub RunMe()
    Application.ScreenUpdating = False
    Dim lRow As Long, lCol As Long

    Dim wb As Workbook, wbNew as Workbook
    Dim ws As Worksheet, wsNew as Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")

    lRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    lCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    Dim cell As Variant
    For Each cell In ws.Range(ws.Cells(1, "B"), ws.Cells(1, lCol))
        Union(ws.Range("A1:A" & lRow), ws.Range(ws.Cells(1, cell.Column), ws.Cells(lRow, cell.Column))).Copy
        Set wbNew = Workbooks.Add
        Set wsNew = wbNew.Sheets("Sheet1")
        Dim yourdesktopaddress As String
        yourdesktopaddress = CreateObject("WScript.Shell").specialfolders("Desktop") & "\Testforvba"
        wsNew.Range("A1").PasteSpecial
    If Not Dir(yourdesktopaddress & "\" & cell.Value & ".xls", vbDirectory) = vbNullString Then
       'MsgBox "exists"
        Application.DisplayAlerts = False
    Else
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:= _
        yourdesktopaddress & "\" & cell.Value & ".xls"
    End If

    wbNew.Close
    Application.DisplayAlerts = True        
    Next cell

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    End Sub

主要问题是，每当宏运行时，Excel都会从零创建文件，这导致Excel再次重新创建每个文件。我已经添加If Not Dir(yourdesktopaddress & "\Testforvba" & cell.Value & ".xls", vbDirectory) = vbNullString部分代码来检查是否已创建此文件，如果不是，现在就创建该文件。如果您删除＆＃34; ＆＃39; ＆＃34;从'MsgBox "exists"开头，它总是告诉你这个文件已经存在。

如果没有很好地定义变量，excel可能会开始覆盖自身，它可能会替换以前的数据。（特别是Range("A1).PasteSpecial和Activeworkbook.close类关键点是最重要的一点。所以我还编辑了整个代码，定义了所有变量，定义了用户的桌面地址，以确保代码适用于每个用户。

如何保存到下一个可用行而不是替换它

1 个答案: