Question

我想在下面实现：

用户选择工作簿
宏应该复制整个工作表（工作表名称：＆＃34;按位置修复摘要＆＃34;）
通过创建名为＆＃34;上周维修摘要＆＃34;
如果用户取消选择工作簿，则宏应退出子。

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

请帮忙。

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

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

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

1 个答案: