将用户选择的工作簿中的特定工作表复制到宏工作簿中

Question

我想实现以下目标：

1. 用户选择工作簿
2. 宏应复制整个工作表（工作表名称：“按位置划分的修复摘要”）
3. 通过创建一个名为“上周维修摘要”的新工作表，将整个工作表数据粘贴到宏工作簿中
4. 如果用户取消选择工作簿，宏应退出子。

最好在不打开所选工作簿的情况下完成此操作。但没有必要。如果它确实打开了用户选择的工作簿。它应该关闭它而不保存。

请帮忙。

过去，我在多文件选择和编译宏方面得到了帮助，这与我的要求相似，我只是调整了一些行以使其工作。我知道这不是正确的方法。此外，如果用户取消选择文件，它不会关闭。

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 

Answer 1

Sub Run()

Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet
Dim TargetFile As Variant

'prompt user to select files
Set TargetFile = Application.FileDialog(msoFileDialogOpen)

With TargetFile
    .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

If TargetFile.SelectedItems.Count = 0 Then
    Exit Sub
Else
    'open the file and assign the workbook/worksheet
    Set DataBook = Workbooks.Open(TargetFile.SelectedItems(1))
    Set DataSheet = DataBook.Sheets("Repair Summary by Location")
    OutBook.Sheets("Last week repair summary").UsedRange.Delete 
    DataSheet.UsedRange.Copy OutBook.Sheets("Last week repair summary").Cells(1, 1) 
    'close the data book without saving
    DataBook.Close False

End If

End Sub