首页 文章

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

提问于
浏览
0

我想在下面实现:

  • 用户选择工作簿

  • 宏应该复制整个工作表(工作表名称:"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 回答

  • 3
    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
    

相关问题