Question

我在目录或文件夹中有几个文件，我想复制一个范围（格式为当前工作表的值）。我有VBA代码，我认为它不符合顺序或代码中缺少某些东西。请帮我解决这个问题。

（我已在目录中的每个文件中定义了命名范围。是否可以使用命名范围进行复制？）

从目录文件中复制给定路径＆amp;来自sheet2＆amp;将其粘贴到文件“workbook.xlsm”Sheet“sheet1”

Sub LoopThroughDirectory()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String
    Filepath = "C:\test"
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
        If MyFile = "workbook.xlsm" Then
            Exit Sub
        End If

        Workbooks.Open (Filepath & MyFile)
        Sheets("Sheet2").Select
        Range("A1:N24").Copy
        Workbooks.Open ("Filepath & workbook.xlsm")

        If Sheets("Sheet1").Range("A1") = vbNullString Then
           Sheets("Sheet1").Range ("A1:N24")
           Selection.PasteSpecial Paste:=xlPasteFormats
           Selection.PasteSpecial Paste:=xlPasteValues
        Else
            Selection.Copy Sheets("sheet1").Cells(A1, Columns.Count).End(xlToLeft).Offset(0, 1)                   
        End If
        MyFile = Dir
    Loop
    End Sub

Answer 1

还有一个问题：

（我已在目录中的每个文件中定义了命名范围。是否可以使用命名范围进行复制？）

这当然是可能的。因此假设Defined Name范围是"DATA"。只需替换此行：

sourceWbk.Sheets("Sheet2").Range("A1:N24").Copy

用这个：

sourceWbk.Sheets("Sheet2").Range("DATA").Copy

实际上，OP提到这个Names是由另一个地址为"A1:N24"的程序生成的。因此，如果地址被更改，则需要更新引用它的每个其他程序，而不是使用Defined Name不必担心它，因为它会照顾它按设计。这就是使用Defined Names的好习惯。

Answer 2

我会用这个方法：

Sub LoopThroughDirectory()

    Dim MyFile As String
    Dim FilePath As String
    Dim colFiles As Collection
    Dim vFile As Variant
    Dim wrkbkSource As Workbook
    Dim wrkbkTarget As Workbook
    Dim rngTarget As Range

    FilePath = "C:\test\"
    MyFile = "workbook.xlsm"

    Set colFiles = New Collection

    EnumerateFiles FilePath, "*.xlsm", colFiles

    Set wrkbkTarget = Workbooks.Open(FilePath & MyFile)

    For Each vFile In colFiles
        If vFile <> FilePath & MyFile Then

            Set wrkbkSource = Workbooks.Open(vFile, False)
            wrkbkSource.Worksheets(1).Range("A1:N24").Copy

            Set rngTarget = wrkbkTarget.Worksheets("Sheet1").Cells(1, wrkbkTarget.Worksheets("Sheet1").Columns.Count).End(xlToLeft)
            rngTarget.PasteSpecial xlPasteFormats
            rngTarget.PasteSpecial xlPasteValues

            wrkbkSource.Close False

        End If
    Next vFile

End Sub

需要此过程来获取文件夹中的所有文件：

Sub EnumerateFiles(ByVal sDirectory As String, _
    ByVal sFileSpec As String, _
    ByRef cCollection As Collection)

    Dim sTemp As String

    sTemp = Dir$(sDirectory & sFileSpec)
    Do While Len(sTemp) > 0
        cCollection.Add sDirectory & sTemp
        sTemp = Dir$
    Loop
End Sub

Answer 3

好的，看看它是否适合你，不得不添加相当多的

amount

循环通过目录VBA以使用格式复制数据

3 个答案: