我要做的是复制/粘贴选定的报告。弹出选择菜单时如何添加默认路径?
Sub PopulateUploaderFunds()
Dim uploadfile As Variant
Dim uploader As Workbook
Dim CurrentBook As Workbook
Set CurrentBook = ActiveWorkbook
MsgBox ("Please select uploader file to be reviewed")
uploadfile = Application.GetOpenFilename()
If uploadfile = "False" Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open uploadfile
Set uploader = ActiveWorkbook
With uploader
Application.CutCopyMode = False
ActiveSheet.UsedRange.Copy
uploader.Close
End With
CurrentBook.Activate
Sheets("Sheet1").Range("A1").PasteSpecial
Application.ScreenUpdating = True
End Sub
我确实更改了您的代码,我很确定您的代码无法正常工作。您正确地从上载者工作簿复制,但随后关闭它并尝试粘贴到当前工作簿中。如果在复制时关闭工作簿,则不会有任何要粘贴的内容。
Option Explicit
Sub PopulateUploaderFunds()
Dim uploadfile As String 'not variant
Dim uploader As Workbook
Dim CurrentBook As Workbook
MsgBox ("Please select uploader file to be reviewed")
uploadfile = Application.FileDialog(msoFileDialogFilePicker)
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "C:" 'here you change the path
.AllowMultiSelect = False
.Filters.Add "CSV", "*.csv"
If .Show <> -1 Then Exit Sub ' if Cancel is pressed
uploadfile = .SelectedItems(1)
End With
Set CurrentBook = ThisWorkbook 'ActiveWorkbook would throw errors, ThisWorkbooks refers to the workbook which contains the code
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set uploader = Workbooks.Open(uploadfile, ReadOnly:=True) 'you can directly set the uploader workbook like this
With uploader
.Sheets("MySheet").UsedRange.Copy CurrentBook.Sheets("Sheet1").Range("A1") 'change MySheet for the name of your working sheet
Application.CutCopyMode = False
.Close SaveChanges:=False
End With
Application.ScreenUpdating = True
End Sub
下面的代码在测试后对我有用。非常感谢@Damian。我将他的代码与我的代码相结合,结果正是我想要的。
Sub PopulateUploaderFunds()
Dim uploadfile As Variant
Dim uploader As Workbook
Dim CurrentBook As Workbook
Set CurrentBook = ActiveWorkbook
MsgBox ("Please select uploader file to be reviewed")
uploadfile = Application.FileDialog(msoFileDialogFilePicker)
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "" 'here place your path
.AllowMultiSelect = False
.Filters.Add "Custom Excel Files", "*.csv, *.xlsx, *.xls, *.txt"
If .Show <> -1 Then Exit Sub ' if Cancel is pressed
uploadfile = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open uploadfile
Set uploader = ActiveWorkbook
With uploader
Application.CutCopyMode = False
ActiveSheet.UsedRange.Copy
uploader.Close
End With
CurrentBook.Activate
Sheets("Sheet1").Range("A1").PasteSpecial
Application.ScreenUpdating = True
End Sub