从一个文件夹中导入第一张纸,但没有一个命名文件导入第二张纸

时间:2019-06-10 13:59:51

标签: excel vba

我希望将所有文件的第一张纸导入到我选择的文件夹中,并重命名为其原始文件名(一个文件除外)。如果文件中存在“预测报告”文件,我想复制第二张纸。

我尝试了一个代码,该代码可以从所有文件导入所有工作表,但是这太过分了,因为我必须进入并删除许多额外的工作表。我下面的代码非常适合导入文件。我正在寻找一种方法添加到“如果有预测报告,请复制第二张纸。”

Sub My Data()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


Dim s As String

Application.ScreenUpdating = 0
With Application.FileDialog(msoFileDialogOpen)
    .Title = "Select all reports:"
    .Filters.Clear
    .Filters.Add "All Excel Files", "*.xl*"
    .AllowMultiSelect = True
    .Show
    If .SelectedItems.Count > 0 Then
        For i = 1 To .SelectedItems.Count
        Workbooks.Open.SelectedItems (i)

            Workbooks.Open .SelectedItems(i)

            With ActiveWorkbook
                s = .Name
                .Sheets(1).Copy     After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(s, ".")(0)
                .Close 0
            End With
        Next


    End If
End With


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

1 个答案:

答案 0 :(得分:0)

使用IF语句测试ActiveWorkbook.name是否为“ Forecast Report.xlsx”(根据需要更改扩展名)。如果找到,请复制.Sheets(2)等。如果找不到,请复制.Sheets(1)

With ActiveWorkbook
    s = .Name

    If s = "Forecast Report.xlsx" Then
        .Sheets(2).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(s, ".")(0)

    Else
        .Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(s, ".")(0)

    End If

End With