ForEach循环中的复制/粘贴功能不执行任何VBA

时间:2018-07-25 16:48:47

标签: vba excel-vba foreach

以前,我遇到的问题是lrSource变量未引用正确的工作表,但是我添加了代码来解决此问题。在纠正此问题之前,由于lrSource变量未获得正确的最后一行,因此代码会将一些数据粘贴到“ MASTER.xlsx”中,但没有正确的部分。现在,我可以获得正确的最后一行,并且没有收到任何错误,但是没有数据复制到文件目标位置(“ MASTER.xlsx”)...有什么建议吗?

Sub btnUpdateSAPData_Click()
'Declaring and Setting Variables
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject

Dim MyDir As String
Dim fil As Scripting.file
Dim FolderSource As Scripting.Folder
Dim FolderPathDest As String, wbDest As Workbook, wsDest As Worksheet
Dim wbSource As Workbook, wsSource As Worksheet
Dim lrDest As Long, fileDest As String, lrSource As Long
Dim CurrentFile As String
Dim fileSource As String

MyDir = "C:\Users\quirk\Desktop\Cory Project\Wave 1A Content\SAPCL Spreadsheets\July 2018"

'Defining destination characteristics
FolderPathDest = "C:\Users\quirk\Desktop\Cory Project\VBA Code\Master FOlder"
fileDest = "C:\Users\quirk\Desktop\Cory Project\VBA Code\Master FOlder\MASTER.xlsx"
'Workbooks.Open Filename:=fileDest
Set wbDest = ActiveWorkbook ' Workbooks("MASTER.xlsx")
Set wsDest = wbDest.Worksheets("Sheet1")


'Looping through files
Set FolderSource = fso.GetFolder(MyDir)
For Each fil In FolderSource.Files
    Debug.Print fil.Name
    CurrentFile = fil.Name
    If Not fso.FileExists(FolderPathDest & "\" & fil.Name) Then
        fso.CopyFile _
        Source:=MyDir & "\" & fil.Name _
        , Destination:=FolderPathDest & "\" & fil.Name
            fileSource = MyDir & "\" & fil.Name
            Workbooks.Open Filename:=fileSource '
            ActiveWindow.Visible = False
            Set wbSource = Workbooks(CurrentFile)
            Set wsSource = wbSource.Worksheets(1)
                lrSource = wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row
                lrDest = wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).Row + 1
                Range("A2:V" & lrSource).Copy Destination:=wsDest.Range("A" & lrDest)
    End If
Next fil

End Sub

0 个答案:

没有答案