Question

我有一个借用和修改过的代码。它使用循环一次打开一组文件，然后将我需要的信息复制粘贴到单独的文件中。我借用了打开文件的部分并遍历每个文件。我修改它来做所有的复制粘贴。如果所选文件夹包含太多文件，则会导致Excel崩溃。任何人都可以帮助我提高效率吗？或者告诉我是否有更好的方法来做到这一点？

With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = Application.DefaultFilePath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With

strPath = sItem
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(strPath)
    strFile = Dir(strPath & "\*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open _
          (Filename:=strPath & "\" & strFile, _
          UpdateLinks:=0, _
          ReadOnly:=True, _
          AddToMRU:=False)             
 nam = wbk.Name
                    Windows(nam).Activate
                   Dim lastRow As String

这些文件都有不同数量的条目，但前两列中的数据总是比所需数据多。 H列中始终存在正确的数据量，因此我选择从那里开始。还有一个我不想复制的两行标题。

            ' Find # of used rows 
                    lastRow = ActiveSheet.Cells(Rows.Count, "H").End(xlUp).Row
                    Range("H" & lastRow).Select
                    rangevar = CDbl(lastRow)
                    rangevar = rangevar - 3
               ' Copy/ Paste/ Arrange....

我认为这部分需要提高效率。我使用偏移和上面找到的范围只从特定（但变化）范围中选择我想要的数据。然后我打开所需的位置并粘贴它。我这样做了5次......所以简化这一点对我来说非常有帮助。

Range("A3", Range("A3").Offset(rangevar, 1)).Select
Selection.Copy
Windows("*** Specific File Name***").Activate
                    Sheets("Master Tab").Select
                    lastRow2 = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
                    Range("B" & lastRow2).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Windows(nam).Activate
Range("E3", Range("E3").Offset(rangevar, 0)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("*** Specific File Name***").Activate
                    Sheets("Master Tab").Select
                    Range("D" & lastRow2).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Windows(nam).Activate
... 5 more copy and pastes...

然后，一旦复制粘贴完成，工作簿将关闭，循环将打开下一个。

        wbk.Close (False)
        strFile = Dir
    Loop

多工作簿循环中的复制粘贴效率

0 个答案: