Question

下面的代码是创建单独的电子表格，但在运行时在新工作簿中。我需要的是将文件导入到现有工作簿或活动工作簿中，如果现有工作簿或活动工作簿中已存在工作表，则覆盖这些文件。

Sub CombineCsvFiles()
'updateby Extendoffice 20151015
    Dim xFilesToOpen As Variant
    Dim I As Integer
    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String
    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.csv), *.csv", , "Kutools for Excel", , True)
    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , "Kutools for Excel"
        GoTo ExitHandler
    End If
    I = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(I))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    Do While I < UBound(xFilesToOpen)
        I = I + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(I))
        xTempWb.Sheets(1).Move , xWb.Sheets(xWb.Sheets.Count)
    Loop
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Kutools for Excel"
    Resume ExitHandler
End Sub

Answer 1

使用其他声明添加Dim whst，然后将I=1和ExitHandler之间的代码更改为此（根据需要更改xWb）：

Set xWb = "Whatever workbook you want"
Application.DisplayAlerts = False 'Stop warnings when deleting existing sheet
Do While I < UBound(xFilesToOpen)
    Set xTempWb = Workbooks.Open(xFilesToOpen(I))
    For Each wsht In xWb.Worksheets 'Cycle sheets to find name match and delete if so
        If wsht.Name = xTempWb.Sheets(1).Name Then
            wsht.Delete
        End If
    Next wsht
    xTempWb.Sheets(1).Move , xWb.Sheets(xWb.Sheets.Count)
    xTempWb.Close False
    I = I + 1 'I increment needs to go at the bottom now we are not doing the first iteration out of the loop
Loop
Application.DisplayAlerts = True

将多个文本文件导入到现有工作簿中的单独工作表

1 个答案: