Question

我正在尝试制作一个vba代码来打开现有的电子表格，并使用源电子表格中的信息行填充该现有电子表格的第一行，然后将其自动保存为在特定单元格中列出的项目名称资源。

任何人都可以帮助我。我不是编码器，只是复制我找到的代码。我正在使用此代码。

Sub Button1_Click()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

On Error GoTo PROC_ERROR

Dim ThisWorkbook As Workbook, NewBook As Workbook
Dim ThisWorksheet As Worksheet, NewWs As Worksheet
Dim i As Integer, j As Integer, k As Integer, ExportCount As Integer

Set ThisWorkbook = ActiveWorkbook
Set ThisWorksheet = ThisWorkbook.Sheets("Sheet1")
ExportCount = 0

For i = 2 To Aslong
    If ThisWorksheet.Cells(i, 1) <> "" Then
        Set NewBook = Workbooks.Open("F:\DBA\Land Opportunities\Set-Up Templates\FOR SALE TEMPLATE.xlsx")
        Set NewWs = Existing.Sheets("Project")
        For j = 2 To 13
            If ThisWorksheet.Cells(i, j) <> "" Then
                NewWs.Cells(1, 1) = ThisWorksheet.Cells(i, j)
            End If
        Next j

        With NewBook
            .Sheets("Sheet2").Delete
            .Sheets("Sheet3").Delete
            .Title = ThisWorksheet.Cells(i, 3)
            .SaveAs Filename:=ThisWorksheet.Cells(i, 3) & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        End With
        ExportCount = ExportCount + 1
    End If
Next i

PROC_ERROR:
If Err.Number <> 0 Then
    MsgBox "This macro has encountered an error and needs to exit. However, some or all of your exported workbooks may still have been saved. Please try again." _
    & vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description, vbInformation
    ExportCount = 0
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub
Else
    MsgBox "Successfully exported " & ExportCount & " workbooks!", vbInformation
    ExportCount = ExportCount
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 1

也许更像这样的事情：

Sub Button1_Click()

    Dim ThisWorkbook As Workbook, NewBook As Workbook
    Dim ThisWorksheet As Worksheet, NewWs As Worksheet
    Dim i As Integer, j As Integer, ExportCount As Integer

    Application.ScreenUpdating = False

    Set ThisWorkbook = ActiveWorkbook
    Set ThisWorksheet = ThisWorkbook.Sheets("Sheet1")
    ExportCount = 0

    i = 2
    While ThisWorksheet.Cells(i, 1) <> ""
        Set NewBook = Workbooks.Open("F:\DBA\Land Opportunities\Set-Up Templates\FOR SALE TEMPLATE.xlsx")
        Set NewWs = NewBook.Sheets("Project")
        For j = 2 To 13
            If ThisWorksheet.Cells(i, j) <> "" Then
                NewWs.Cells(1, 1) = ThisWorksheet.Cells(i, j)
            End If
        Next j

        With NewBook
            Application.DisplayAlerts = False
            .Sheets("Sheet2").Delete
            .Sheets("Sheet3").Delete
            Application.DisplayAlerts = True
            .Title = ThisWorksheet.Cells(i, 3)
            .SaveAs Filename:=ThisWorksheet.Cells(i, 3) & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        End With
        ExportCount = ExportCount + 1
        i = i + 1
    Wend

    Application.ScreenUpdating = True

End Sub

我摆脱了一堆混乱。一旦你看到你的错误发生在哪里，如果你愿意的话，你可以把错误捕获。[/ p>

我不知道这是否符合你的要求，但另一件事肯定是因为For i = 2 To Aslong被打破而无法正常工作，而且＃as;＆＃39; Aslong＆＃39;没有设置任何东西。此外，Existing.Sheets("Project")不是任何事情，因为Existing不是一个对象。您还调暗了一个从未使用过的k变量。

VBA将源doc中的行导出到现有文档并另存为新文件

1 个答案: