将打开的文件名添加到新工作簿中的单元格,以便我可以将其用作标题和放大器。使用文件1和文件2命名我新添加的工作簿

时间:2018-06-13 21:34:26

标签: excel-vba vba excel

我正在使用msoFileDialogFilePicker打开两个文件,将数据导入新工作簿进行比较。我想在我的新工作簿中使用文件名作为标题PLUS使用文件名来命名我的新工作簿。例如,二月销售与三月Sales.xlsx以及我的工作表标签中的标题。单元格A1中的文件1和单元格O2中的文件名称2。提前谢谢!

Sub ImportSalesData()        Application.DisplayAlerts = False

   Dim directory As String, Filename As String, sheet As Worksheet, total As 
         Integer
   Dim fd As Office.FileDialog
   Dim wb As Workbook
   Dim Wb2 As Workbook
   Dim sht As Worksheet



   Set fd = Application.FileDialog(msoFileDialogFilePicker)

   With fd
    .AllowMultiSelect = False
    .Title = "Select the first sales month"
    .Filters.Clear


    If .Show = True Then
      Filename = Dir(.SelectedItems(1))

    End If
   End With

    Workbooks.Open (Filename)

    Set range1 = Range("A:M")
    range1.Copy

    Set newbook = Workbooks.Add
    ActiveSheet.Name = "Compare Sales"
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "Name of File 1  and Name of File 2", xlWorkbookNormal


    Set fd = Application.FileDialog(msoFileDialogFilePicker)

   With fd
    .AllowMultiSelect = False
    .Title = "Select the second sales month"
    .Filters.Clear


    If .Show = True Then
      Filename = Dir(.SelectedItems(1))

    End If
   End With


   Workbooks.Open (Filename)



Set range2 = Range("A:M")
range2.Copy
Workbooks("Name of File 1  and Name of File 2").Activate
Sheets("Compare Sales").Activate
Range("O1").Select
Selection.PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Worksheets("Compare Sales").Cells.EntireColumn.AutoFit

End Sub

2 个答案:

答案 0 :(得分:0)

我相信您正在寻找.Name财产。

可以按如下方式使用以返回工作簿,表格等的名称。您需要将其用于工作簿,因此您可以按如下方式使用。

MsgBox Replace(ThisWorkbook.Name, ".xlsx", "")
MsgBox Replace(ActiveWorkbook.Name, ".xlsx", "") 

您可以在代码中实现它:

Dim WBook1 as String
Dim WBook2 as String
WBook1 = Replace(ThisWorkbook.Name, ".xlsx", "")
WBook2 = Replace(ActiveWorkbook.Name, ".xlsx", "") 

然后,您可以参考WBook1&只要你需要WBook2

答案 1 :(得分:0)

测试:

Option Explicit

Sub ImportSalesData()

    Dim Wb1 As Workbook
    Dim Wb2 As Workbook
    Dim wbNew As Workbook
    Dim sht As Worksheet, nm1 As String, nm2 As String

    'choose the workbooks
    Set Wb1 = ChooseWorkbook("Select the first sales month")
    If Wb1 Is Nothing Then Exit Sub

    Set Wb2 = ChooseWorkbook("Select the second sales month")
    If Wb2 Is Nothing Then Exit Sub

    'get the names, ignoring the extension
    nm1 = Split(Wb1.Name, ".")(0)
    nm2 = Split(Wb2.Name, ".")(0)

    Set wbNew = Workbooks.Add()
    Set sht = wbNew.Sheets(1)

    sht.Name = "Compare Sales"

    'probably should not use full-column ranges....
    sht.Range("A:M").Value = Wb1.Sheets(1).Range("A:M").Value
    sht.Range("O:AA").Value = Wb2.Sheets(1).Range("A:M").Value

    sht.UsedRange.EntireColumn.AutoFit

    Wb1.Close False 'close source workbooks without saving
    Wb2.Close False

    wbNew.SaveAs ThisWorkbook.Path & "\" & nm1 & " and " & nm2 & ".xlsx"

End Sub

'let the user pick a file...
' Returns Nothing if no selection
Function ChooseWorkbook(sTitle As String)
    Dim rv As Workbook
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = sTitle
        .Filters.Clear
        If .Show = True Then Set rv = Workbooks.Open(.SelectedItems(1))
    End With
    Set ChooseWorkbook = rv
End Function