VBA陷入嵌套循环

我正在写一个代码,将工作簿(fromWB)名称(tempName)的前几个字符与工作表(sheetName)的名称进行比较。 如果它们匹配,则文件中的数据将被复制到工作表(ws)中。 我试图让我的代码遍历文件的文件夹,并通过工作簿(从WB)与多个工作表,但代码被困在do while循环(遍历工作表),我不知道如何修理它。 它停止复制并粘贴到工作表中,因为tempName不会更改,因为代码没有循环通过文件的文件夹。 我debugging的代码,我没有得到任何错误。 任何帮助,将不胜感激!!

编辑:将两个嵌套F​​or Each循环工作?

Sub Import(Optional sPath As Variant) Dim SelectFolder As FileDialog Dim fromWB As Workbook Dim toWB As Workbook Dim ws As Worksheet Dim fileName As String Dim sheetName As String Dim tempName As String 'Application.ScreenUpdating = False 'Application.DisplayAlerts = False 'Application.EnableEvents = False 'Retrieve Target Folder Path From User Set SelectFolder = Application.FileDialog(msoFileDialogFolderPicker) With SelectFolder .Title = "Select a Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode sPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: sPath = sPath If sPath = "" Then GoTo ResetSettings sFile = Dir(sPath & "*xlsx") Workbooks("Temp.xlsx").Activate Set toWB = ActiveWorkbook Do While sFile <> "" Set fromWB = Workbooks.Open(sPath & sFile) tempName = Left(sFile, 3) Range("A1:B10").Select Selection.Copy For Each ws In toWB.Worksheets Windows("Temp.xlsx").Activate sheetName = ActiveSheet.Name If sheetName = tempName Then ws.Activate Range("A4").PasteSpecial xlPasteAllUsingSourceTheme End If ws.Activate Next ws sFile = Dir() Loop ResetSettings: Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End Sub 

我不认为你的每个循环都有问题。 在我看来,它会陷入do while循环中。

你不会在循环中的任何地方改变sFile,所以它永远不会中断。

 Do While sFile <> "" Loop 

编辑:

 Sub LoopThroughFiles() Dim MyObj As Object, MySource As Object, file As Variant file = Dir("c:\testfolder\") While (file <> "") 'code here file = Dir Wend End Sub 

发件人: 使用VBA循环浏览文件夹中的文件?