Question

我有一个包含大量工作簿的文件夹，我需要将文件名（和其他一些数据）复制到主工作簿。我找到了一个导入数据的代码，但似乎无法导入文件名。

＆＃34;＆＃39; ＆GT;＆GT;＆GT;＆GT;＆GT;＆GT;适应这部分＆＃34;我试着写一些代码来复制和粘贴文件名，但它似乎没有用。

我使用＆＃34;＆＃39;之外的部分。＆GT;＆GT;＆GT;＆GT;＆GT;＆GT;适应这部分＆＃34;复制一些其他数据所以我只需要一些代码来适应我不工作的代码：）

Sub Import_to_Master()
    Dim sFolder As String
    Dim sFile As String
    Dim wbD As Workbook, wbS As Workbook

    Application.ScreenUpdating = False
    Set wbS = ThisWorkbook
    sFolder = wbS.Path & "\"

    sFile = Dir(sFolder)
    Do While sFile <> ""

        If sFile <> wbS.Name Then
            Set wbD = Workbooks.Open(sFolder & sFile)

             ' >>>>>> Adapt this part

            WName = ActiveWorkbook.Name
            WName.Copy
            Sheets("Combined").Range("N" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False

             ' >>>>>>

            wbD.Close savechanges:=True 'close without saving

        End If

        sFile = Dir 'next file
    Loop
    Application.ScreenUpdating = True
End Sub

Answer 1

Sub Import_to_Master()

    Dim sFolder As String
    Dim sFile As String
    Dim wbD As Workbook, wbS As Workbook

    Application.ScreenUpdating = False
    Set wbS = ThisWorkbook
    sFolder = wbS.Path & "\"

    sFile = Dir(sFolder)
    Do While sFile <> ""

        If sFile <> wbS.Name Then
            Set wbD = Workbooks.Open(sFolder & sFile)

             ' >>>>>> Adapt this part

            wbS.Sheets("Combined").Range("N" & wbS.Sheets("Combined").Rows.Count).End(xlUp).Offset(1, 0).Value = sFile

             ' >>>>>>

            wbD.Close savechanges:=True 'close without saving

        End If

        sFile = Dir 'next file
    Loop
    Application.ScreenUpdating = True
End Sub

Answer 2

您可以直接使用对象wbD及其属性.Name。

我还添加了对工作表的引用（＆＃34; Combined＆＃34;）以提高可读性：

Sub Import_to_Master()
    Dim sFolder As String
    Dim sFile As String
    Dim wbD As Workbook, wbS As Workbook
    Dim wSc As Worksheet

    Application.ScreenUpdating = False
    Set wbS = ThisWorkbook
    '''Define the sheet
    Set wSc = wbS.Sheets("Combined")
    sFolder = wbS.Path & "\"

    sFile = Dir(sFolder)
    Do While sFile <> ""

        If sFile <> wbS.Name Then
            Set wbD = Workbooks.Open(sFolder & sFile)

             ' >>>>>> Adapt this part
            wSc.Range("N" & wSc.Rows.Count).End(xlUp).Offset(1, 0).value = wbD.Name

             ' >>>>>>

            wbD.Close savechanges:=True 'close without saving

        End If

        sFile = Dir 'next file
    Loop
    Application.ScreenUpdating = True
End Sub

将文件名从多个工作簿复制到另一个工作簿中的单元格

2 个答案: