Question

我正在尝试从通过“文件对话框”打开的文件中的标签中复制信息，并将其粘贴到“ ThisWorkbook”中

以下是我的尝试。我不断收到错误

“对象不支持此属性或方法”

以粗体显示在行上。

Sub UpdateWeeklyJobPrep()
    Dim xlFileName As String
    Dim fd As Office.FileDialog
    Dim source As Workbook
    Dim currentwk As Integer
    Dim wksheet As String
    Dim target As ThisWorkbook
    Dim fso As Object
    Dim sourcename As String

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

     'Calc the current fiscal week
      currentwk = WorksheetFunction.WeekNum(Now, vbMonday)
      wksheet = "FW" & currentwk

    With fd
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1

        If .Show Then
           xlFileName = .SelectedItems(1)                   
        Else
           Exit Sub
        End If

    End With

    'Opens workbook
    Workbooks.Open (xlFileName), ReadOnly:=True

    'Get file name from path
    Set fso = CreateObject("Scripting.FileSystemObject")
    sourcename = fso.GetFileName(xlFileName)
    sourcename = Left(sourcename, InStrRev(sourcename, ".") - 1)

    'Copy/Paste Code Here
    **Workbooks(sourcename).Activate**
    Workbooks(sourcename).Worksheets(wksheet).Column("F").Copy
    target.Activate
    target.Sheets("Data Source").Column("C").PasteSpecial

    'close workbook with saving changes
    source.Close SaveChanges:=False
    Set source = Nothing


End Sub

Answer 1

我认为我有一个解决方案。首先，正如我在上面的评论中提到的那样，您应该使用一个变量来保存新的打开的工作簿。

Sub UpdateWeeklyJobPrep()
Dim xlFileName As String
Dim fd      As Office.FileDialog
Dim source  As Workbook
Dim currentwk As Integer
Dim wksheet As String
Dim fso     As Object
Dim sourcename As String

Dim mainWB  As Workbook

Set mainWB = ThisWorkbook

Set fd = Application.FileDialog(msoFileDialogFilePicker)

'Calc the current fiscal week
currentwk = WorksheetFunction.WeekNum(Now, vbMonday)
wksheet = "FW" & currentwk

With fd
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
    If .Show Then
        xlFileName = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

'Opens workbook
Dim newWB   As Workbook
Set newWB = Workbooks.Open(xlFileName, ReadOnly:=True)

'Copy/Paste Code Here
mainWB.Sheets("Data Source").Column("C").Values = newWB.Worksheets(wksheet).Column("F").Values
newWB.Close savechanges:=False
Set newWB = Nothing
End Sub

假设您只是需要值，我还更改了Copy/PasteSpecial位。请注意，由于您要复制整列，这可能需要一些时间。相反，您可能只想将该范围最小化为仅使用的行，但是我将其留给读者练习。

使用通过VBA通过“文件”对话框打开的文件

1 个答案: