我正在使用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
答案 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