我想在下面实现:
-
用户选择工作簿
-
宏应该复制整个工作表(工作表名称:"Repair Summary by Location")
-
通过创建名为"Last week repair summary"的新工作表将整个工作表数据粘贴到宏工作簿中
-
如果用户取消选择工作簿,则宏应退出sub .
优选地,这应该在不打开所选工作簿的情况下完成 . 但没有必要 . 如果确实打开了用户选择的工作簿 . 它应该关闭它而不保存 .
请帮忙 .
我在过去的多文件选择和编译宏上获得了类似于我的要求的帮助,我只是调整了一些行来使其工作 . 我知道这不是正确的方法 . 此外,如果用户取消选择文件,它不会关闭 .
Sub Run()
Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As Variant
Dim MaxNumberFiles As Long, FileIdx As Long, _
LastDataRow As Long, LastDataCol As Long, _
HeaderRow As Long, LastOutRow As Long
Dim DataRng As Range, OutRng As Range
'initialize constants
MaxNumberFiles = 1
HeaderRow = 1 'assume headers are always in row 1
LastOutRow = 1
'prompt user to select files
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
With TargetFiles
.AllowMultiSelect = False
.Title = "Select the last week report:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
'set up the output workbook
Set OutBook = ThisWorkbook 'Worksheets.Add
Set OutSheet = OutBook.Sheets.Add
OutSheet.Name = "Last Week Repair Summary"
Set OutSheet = OutBook.Sheets(1)
'loop through all files
For FileIdx = 1 To TargetFiles.SelectedItems.Count
'open the file and assign the workbook/worksheet
Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
Set DataSheet = DataBook.Sheets("Repair Summary by Location")
'identify row/column boundaries
LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastDataCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
'if this is the first go-round, include the header
Set DataRng = Range(DataSheet.Cells(HeaderRow, 1), DataSheet.Cells(LastDataRow, LastDataCol))
Set OutRng = Range(OutSheet.Cells(HeaderRow, 1), OutSheet.Cells(LastDataRow, LastDataCol))
'copy the data to the outbook
DataRng.Copy OutRng
'close the data book without saving
DataBook.Close False
Next FileIdx
End Sub
1 回答