VBA无法将数据从多个工作簿传输到主工作簿

Question

I am using Excel 2013 and trying to use the code below from a tutorial Transfer to Master from Multiple Workbooks to transfer data from multiple workbooks into a master workbook. It adds the data from the multiple wkbks to the master wkbk with the data pasted below the data above it each time, not on separate spreadsheets in the master.

I put the code in the MASTER workbook, per the tutorial but nothing happens. I don't know VBA too well. I just learned how to put a break and run the code, but that doesn't really tell me anything, I don't think.

1. I have a folder on my desktop called 'merge' with a macro enabled wkbk called MASTER, the 3 other non-macro wkbks called tblScheduleMergeTWO, tblScheduleMergeTHREE, and tblScheduleMergeFOUR.
2. Each wkbk, including the MASTER, has 9 columns with the same field headings, which I don't think matters with this code.
3. The 3 wkbks I need to copy from each has different shading on the data so I can tell which data came from which wkbk when it does paste over to the MASTER.

What I've Tried: POSTER'S EDIT -

4. I open the MASTER wkbk and put my cursor in that wkbk and run the code from there.

5. I've tried it with one of the other wkbks I need to copy from open and tried it with it closed and the screen will flash once sometimes but nothing happens in terms of copying any data.

6. Per @Tony Dallimore suggestion, moved Active.Workbook.Close after the ActiveSheet.Paste Destination: and after Loop Application.DisplayAlerts = True and it did not change anything. I'm not sure it does erase anything to close the wkbk, but he would know better.

7. Per #Tony Dallimore suggestion, changed Cells(erow, 9) to Cells(erow, lastcolumn) , separately and with the other edits, and nothing changed.

8. Did not understand #Tony Dallimore's 3rd suggestion. Was it to replace Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy with SrcRange.Copy Destination:=DestTopLeftCell? I didn't see that it would cover lastrow to lastcolumn.`

9. I also tried another tutorial but it did not work either from enter link description here . Did not post code to save room.

10/1/19 11:19 AM Poster's Edit 10. Per @Thomas Inzina's suggestion, I used F8 to troubleshoot line by line in his code that he posted. I noticed right away using F8 that the beginning line of code 'With ThisWorkbook.Worksheets("Sheet1")' shows up in the screen tip as FileName="" when you click on ThisWorkbook or click on Sheet1. It doesn't look like it even recognizes ThisWorkbook, which is really called MASTER.xlsm. What's happening with that? The screen tip does show the file name, however, when you hover your cursor over 'Do While FileName <> ""'. When I press F8 then, it gives a popup msg saying Your MASTER file is already opened and could damage to reopen. When I select NO, that I don't want it opened again, I get an error msg asking if I want to end or Debug. If I Debug, then 'With Workbooks.Open(FolderPath & FileName)' is highlighted as the problem. I just need to save and close the Master wkbk and then that trouble is gone; however, hitting F8 after 'With Workbooks.Open(FolderPath & FileName)'skips the rest of the code and goes back to the beginning. In all of this, I don't see that the code is giving a screen tip showing that it notices the wkbks I need to copy from.

I would appreciate the help. I'm going to check into this post Other post to t/f data from multiple wkbks , too.

Is FileName = Dir wrong, perhaps?

Sub copyDataFromMultipleWorkbooksIntoMaster()

Dim FolderPath As String
Dim FilePath As String
Dim FileName As String
'or Dim FolderPath As String, FilePath As String, FileName As String

FolderPath = "C:\Users\PC-1\Desktop\Merge\"
FilePath = FolderPath & "*.xls*"
FileName = Dir(FilePath)

'Don't know how many rows of data so define last row and column
Dim lastrow As Long
Dim lastcolumn As Long
'will use in a loop as number columns and rows from which extract data

Do While FileName <> ""
Workbooks.Open (FolderPath & FileName)

'Assign value to last row
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlLeft).Column

Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
'to disable alerts that you have a lot of data copied to clipboard, etc.
Active.Workbook.Close

'when go back to master to paste, we need to know which is next blank row to paste data
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
'Offset to go to next row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 9))

FileName = Dir

Loop
Application.DisplayAlerts = True



End Sub

10/2/2016 Poster's Edit - In response to Tony Dallimore - Tony, I read through the code but thought I understood enough to run it and see what happens (I am, however, going to study it more in depth and retype it); however, nothing happened when I tried to run it. Was I supposed to substitute anything like my workbook(s) name or any worksheet name, ex: WshtDestName, into the code?

I received a Run Time Error 9 Subscript out of Range error and when I debugged it, Set WshtDest = WbkDest.Worksheets(WshtDestName) was highlighted.

I thought I might ought to substitute WshtDestName above with the name of my wksht in my MASTER.xlsm file. So, I put "Sheet1" in the parentheses. There was no error msg, but nothing happened either.

I thought maybe I was to substitute the "Data" in the 2 constants, Const WshtDestName As String = "Data" and Const WshtSrcName As String = "Data" with my wksht's name in both wkbks, so I put "Sheet1" where "Data" was, and, again, nothing happened.

I didn't know if the constants at the beginning were supposed to be after the Sub so I moved them to be after the Dim's under Sub and nothing happened then.

When I hit F8 to look at each line of code, here is what the screen tip says:

• For Application.ScreenUpdating = False it says Application.ScreenUpdating = True

• For Set WbkDest = ThisWorkbook the screen tip says for WbkSet = Nothing and for ThisWorkbook = , but only says these things when yellow highlighted. When hit F8 and move off that line, it doesn't say anything when I put the cursor over it.

• For Set WshtDest = WbkDest.Worksheets(WshtDestName) the screen tip says for WshtDest = Nothing and for WbkDest.Worksheets(WshtDestName) = Subscript out of range and if cursor is just over (WshtDestName), it says ("Data"), but only says these things when yellow highlighted. When hit F8 and move off that line, it doesn't say anything when I put the cursor over it.

• I'm not able to F8 past this unless I change ("Data") to ("Sheet1"). I can F8 to FolderPath = WbkDest.Path & "\\" = "C:\\Users|PC-1\\Destktop\\Merge\\" in the screen tip where WbkDest.Path = "C:\\Users|PC-1\\Destktop\\Merge", which is correct.

• FilePath = FolderPath & " .xls " = "C:\\Users|PC-1\\Destktop\\Merge\\".xls*" in the screen tip where FolderPath is correct as above, "C:\\Users|PC-1\\Destktop\\Merge\\"

• FileName = Dir$(FilePath) = "MASTER.xlsm" in screen tip and FilePath is equal to "C:\\Users|PC-1\\Destktop\\Merge*.xls*" as above.

• Set RngDest = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious) where RngDest = Nothing in tip and nothing pops up in screen tip except -4123 for xlFormulas, and 1 for xlByRows, and 2 for xlPrevious.

• If RngDest Is Nothing Then where RngDest = Nothing in tip

• HeaderCopied = False = HeaderCopied = False in tip which is not true b/c my destination wkbk, MASTER.xlsm has a header row already in the 1st row.

• RowDestNext = 1 = RowDestNext = 1 in screen tip

• It then jumps to EndIf and EndWith

• Do While FileName <> "" And FileName <> WbkDest.Name where both FileName and WbkDest.Name = "MASTER.xlsm" in screen tip.

• F8 then jumps through the rest of the code to the end where

  With WshtDest .Cells.EntireColumn.AutoFit End With, etc.

I ran your code just as you typed it, as well, except I commented out the section you said to comment out if I did have headers and I uncommented the section you said to uncomment. It still didn't work.

Answer 1

You can copy directly directly to the destination range and avoid using the clipboard altogether.

Sub copyDataFromMultipleWorkbooksIntoMaster()

    Dim FileName As String, FilePath As String, FolderPath As String
    Dim lastrow As Long, lastcolumn As Long
    Dim LastCell As Range

    With ThisWorkbook.Worksheets("Sheet1")
        Set LastCell = .Cells(.Rows.Count, 1)
    End With

    FolderPath = "C:\Users\PC-1\Desktop\Merge\"
    FilePath = FolderPath & "*.xls*"
    FileName = Dir(FilePath)

    Do While FileName <> ""
        With Workbooks.Open(FolderPath & FileName)

            'Assign value to last row
            lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            lastcolumn = .Cells(1, .Columns.Count).End(xlLeft).Column

            .Range("A2", .Cells(lastrow, lastcolumn)).Copy LastCell.End(xlUp).Offset(1)

            .Close False

        End With
        FileName = Dir

    Loop

End Sub

Answer 2

I have set up a folder and workbooks that match your description. The revised code below works for me. I hope the original code was all yours. I can easily forgive a newbie for some of the mistakes and bad practices but I would be appalled if you got this from a tutorial as you suggest.

I have included comments to explain all my changes. Come back for more explanations if necessary but the more you decipher my code for yourself, the faster you will develop your skills. I include comments to say what the code is doing but few comments about the statements themselves. For example, Option Explicit is easy to look up once you know it exists so its purpose is not explained.

Option Explicit         ' Always have this statement at the top of every module

  ' Constants are fixed while a macro is running but can be changed
  ' if the data is redesigned. This defines the first data row of every
  ' worksheet is 2. That is, it allows for one header row. I could have used
  ' 2 within the code below. If you ever have to update code because the
  ' number of header rows has changed or a new column has been inserted in
  ' the middle of existing columns, you will understand why I use constants.
  Const RowDataFirst As Long = 2        ' Set to 1 if no header rows

  ' You assume that when you open a workbook, the active worksheet is the one
  ' required. This is only reliable if the workbooks only have one worksheet.
  ' I have defined one constant for the name of the worksheet within the
  ' destination workbook and one for name of the worksheet within every
  ' source workbook. I assume this is adequate. I will have alternative
  ' suggestions if it is not adequate.
  Const WshtDestName As String = "Data"
  Const WshtSrcName As String = "Data"
Sub copyDataFromMultipleWorkbooksIntoMaster()

  Dim FolderPath As String
  Dim FilePath As String
  Dim FileName As String
  Dim HeaderCopied As Boolean
  Dim RowDestNext As Long
  Dim RngDest As Range
  Dim RngSrc As Range
  Dim WbkDest As Workbook
  Dim WbkSrc As Workbook
  Dim WshtDest As Worksheet
  Dim WshtSrc As Worksheet

  Application.ScreenUpdating = False

  ' You need row numbers in both the source and the destination worksheets.
  ' Use names for variables that tell you exactly what the variable is for.
  ' While you are writing a macro, it is easy to remember odd names but if
  ' you return to the macro in six or twelve months will you still remember?
  ' I have a naming system which I always use. I can look at macros I wrote
  ' ten years ago and know what all the variable are which is an enormous help
  ' when updating old code. If you do not like my system then develop your own.
  ' My names consist of a series of keywords with the most global first.
  ' "Row" says the variable is a row number. "Wbk" says the variable is a
  ' workbook. "RowXxx" says the variable is a row number within worksheet or
  ' array Xxxx. "RowSrcXxx" says the variable is a row number for worksheet
  ' "Source". "Xxx" can be "First", "Crnt", "Next", Prev", "Last" or whatever
  ' I need for the current macro

  Dim RowSrcLast As Long

  ' My comment suggested you be consistent in your use of column numbers but
  ' comments do not allow enough room to explain. With some statements, having
  ' a different number of rows or columns in the source and destination can
  ' give funny results with truncation or duplication. If you know you only
  ' want 9 columns then use 9 in both source and destination ranges. If the
  ' number of columns might change then determine the number at runtime.
  Dim ColSrcLast As Long

  ' If you are handling multiple workbooks be explicit which workbook
  ' you are addressing.  This assumes the workbook into which the worksheets
  ' are collected is the workbook containing the macro.
  Set WbkDest = ThisWorkbook

  Set WshtDest = WbkDest.Worksheets(WshtDestName)
  ' Note a worksheet variable references the worksheet within its workbook.
  ' I do not need to write WbkDest.WshtDest.

  ' FolderPath = "C:\Users\PC-1\Desktop\Merge\"
  ' You can hard code the name of the folder into a macro but it is
  ' a bother when you move your workbooks. When all your workbooks
  ' are in the same folder, the following is more convenient
  FolderPath = WbkDest.Path & "\"

  FilePath = FolderPath & "*.xls*"

  ' Note Dir searches down the folder index for files that match the template.
  ' The sequence in which they are found depends on the sequence in which the
  ' files were added to the folder. There are other techniques if sequence is
  ' important.
  FileName = Dir$(FilePath)         ' Dir$ is marginally faster than Dir

  ' Your existing code adds new data to the end of the existing worksheet in
  ' Master.xlsm. This may be correct but it is more usual to clear the
  ' destination at the start of each run. Comment out the first block and uncomment
  ' the second block if you want to add to existing data.

  With WshtDest
    .Cells.EntireRow.Delete  ' Delete every row in worksheet
    HeaderCopied = False     ' There is no header within the destination worksheet
    RowDestNext = 1          ' First (only) header row will be copied from first
                             ' source worksheet to this row
  End With

  ' If you know that column A of the used rows of the active sheet contains no
  ' blank cells, the following is the easiest way of finding that last used row:
  '   RowDestLast = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
  ' But this technique is unreliable if there might be blank cells. No technique
  ' is 100% reliable but you would have very strange data if the technique I have
  ' used is not reliable for you.

  'With WshtDest
  '  ' Find last row with a value
  '  Set RngDest = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
  '  If RngDest Is Nothing Then
  '    ' No data has been found so the worksheet is empty
  '    HeaderCopied = False     ' There is no header within the destination worksheet
  '    RowDestNext = 1          ' First (only) header row will be copied from first
  '                             ' source worksheet to this row
  '  Else
  '    ' There is data within the worksheet. Assume the header row(s) are present.
  '    HeaderCopied = True
  '    RowDestNext = RngDest.Row + 1
  '  End If
  'End With

  ' Please indent your code within Do-Loops, If, etc. It makes your code
  ' much easier to read.

  ' All your workbooks are within the same folder. Master.xlsm will be one
  ' of those found but you do not want to use it as a source workbook.

  Do While FileName <> ""
    If FileName <> WbkDest.Name Then
      Set WbkSrc = Workbooks.Open(FolderPath & FileName)

      ' WbkSrc will be the active workbook but better to reference it explicitly

      With WbkSrc
        Set WshtSrc = .Worksheets(WshtSrcName)
      End With

      With WshtSrc
        ' Find last row with data if any
        Set RngSrc = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
        If RngSrc Is Nothing Then
          ' No data has been found so the worksheet is empty
        Else
          RowSrcLast = RngSrc.Row
          ' Find last column with data. Already know there is data
          RngSrc = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious)
          ColSrcLast = RngSrc.Column

          If HeaderCopied Then
            ' Already have header row(s) in destination worksheet
            Set RngSrc = .Range(.Cells(RowDataFirst, 1), .Cells(RowSrcLast, ColSrcLast))
          Else
            ' Do not have header row(s) in destination worksheet. Include them in copy.
            Set RngSrc = .Range(.Cells(1, 1), .Cells(RowSrcLast, ColSrcLast))
            HeaderCopied = True
          End If
          RngSrc.Copy Destination:=WshtDest.Cells(RowDestNext, 1)  ' Copy data and formats
          RowDestNext = RowDestNext + RngSrc.Rows.Count            ' Step ready for next copy
        End If
      End With  ' WshtSrc

      WbkSrc.Close SaveChanges:=False
      Set WshtSrc = Nothing
      Set WbkSrc = Nothing

    End If  ' FileName <> WbkDest.Name

    FileName = Dir$

  Loop  ' While FileName <> "" And FileName <> WbkDest.Name

  With WshtDest
    .Cells.EntireColumn.AutoFit
  End With

  Application.ScreenUpdating = True

End Sub

New section in response to OP's comments on original answer

There are some things I really should have included in my original answer but you have also strayed into areas I could not have expected. You have also found a bug which my own testing missed.

“Was I supposed to substitute anything like my workbook(s) name …”

I should have made this clear. In Const WshtDestName As String = "Data" , “Data” is my name for the worksheet in which I accumulate the data. I should have told you to replace “Data” with your name for the worksheet.

Your comments suggest you have replaced:

 Set WshtDest = WbkDest.Worksheets(WshtDestName)

with

 Set WshtDest = WbkDest.Worksheets("Sheet1")

If so, please update the Const statement instead. The objective of using Const statements is to isolate things that might change from the main body of the code. This makes maintenance easier.

Avoid using the default names “Sheet1”, “Sheet2” and so on. As your data and your macros get more complicated, it makes life much easier if worksheet names reflect the worksheet contents.

[ Note from OP: I renamed my master wksht to 'Combined' and my source's wkshts to 'Node Export By Hub', and replaced the 'Sheet1' name in the Constants with those names.]

I use WbkDest.Name as the name of the master workbook. You do not need to change this to your actual workbook name. Using properties like this makes your code much easier to maintain because the property value will change if you rename the workbook.

I received a Run Time Error 9 Subscript out of Range error and when I debugged it, Set WshtDest = WbkDest.Worksheets(WshtDestName) was highlighted.

This paragraph may be beyond your current knowledge of VBA. Read it and extract what understanding you can. It will become clearer as you advance to arrays and collections. Worksheets is a Collection or what most programming languages call a list. A collection is like an array except you can add new values in the middle and delete existing values. Within arrays, entries are only accessible via an index number, for example: MyArray(5) . Entries within a collection are accessible via an index but collection entries can also have a key . If I had written Worksheets(5) this would have given error 9 because there is no worksheet 5. When you ran the macro, WshtDestName had a value of “Data”. There was no Worksheets("Data") so you got error 9. If you update the Const statement, this error will go because Worksheets("Sheet1") exists.

I didn't know if the constants at the beginning were supposed to be after the Sub so I moved them to be after the Dim's under Sub and nothing happened then.

Here you have strayed into the topic of "Scope". If I declare a constant or a variable within a subroutine or a function, it is only visible within that subroutine or function. The “scope” of the constant or variable is the function. If I declare a constant or a variable at the top of a module, it is visible to every subroutine or function within that module but not to those in other modules. The “scope” of the constant or variable is the module. If I add “Public” to the declaration, the constant or variable is visible to every subroutine or function in every module or user form within the workbook. The “scope” of the constant or variable is the workbook.

[ Note from OP: This is interesting to know because I couldn't find information about constants before the Sub via Google. Thank you.]

This workbook has only one subroutine and only one module and no user forms so it does not really matter where you place the constant declarations. The most appropriate scope for a constant or variable is a complicated issue and I am not going to attempt an introduction. I will just say that these constants are recording my assumptions about the workbook. If there had been multiple modules I would have defined them as Public.

You need to review all my assumptions. I do not have your data. I have made up data that I believe matches your data. But if any of my assumptions about your data are wrong, the macro will not work.

When I hit F8 to look at each line of code, here is what the screen tip says: For Application.ScreenUpdating = False it says Application.ScreenUpdating = True

When a statement is yellow, it has not yet been executed. With most statements, you can actually amend it before pressing F8 again to execute it. So if you have a yellow A = A + 2 and you think: “I meant A = A + 3 ”, you can correct the statement before execution.

True is the default value for Application.ScreenUpdating so that is the value you see before Application.ScreenUpdating = False is executed.

For Set WbkDest = ThisWorkbook the screen tip says for WbkSet = Nothing and for ThisWorkbook = , but only says these things when yellow highlighted. When hit F8 and move off that line, it doesn't say anything when I put the cursor over it.

If you hover over an ordinary variable (data type = Long, String, Boolean, etc.), the interpreter will display its value. An object (such as WbkDest) has lots of properties; which should the interpreter display? Some objects, such as Range , have a default property. For Range this is Value so if you hover over a range, you see the value. A workbook has no default property so the interpreter doesn't display anything.

Go down to the Immediate Window and type ? WbkDest.Name ? WbkDest.Name and click Enter . The interpreter will display the workbook's name. You can get the value of any of the workbook's properties displayed. You can also display sub-properties, for example: WbkDest.Worksheets.Count or WbkDest.Worksheets("Sheet1").Range("A1").Value .

[ Note from OP: 1st error - I received a Run-time '424': Object required error when I typed '? WbkDest.Name' and hit Enter in the Immediate Window. Is it not recognizing WbkDest because it is declared in the beginning Dim and later Set = This Workbook. I changed the name to my MASTER.xlsm to MASTER_DESKTOP TEST.xlsm but that shouldn't matter because we never explicitly mention it in this code, correct?]

Response from TD to above note Dim X As Type reserves some space for X and sets its value to the default for the type. For type Long, the value will be zero. For type Object (Workbook is a sub-type of Object), the default value is Nothing. Nothing does not have any properties so at this stage ? WbkDest.Name ? WbkDest.Name will give an error. When statement Set WbkDest = ThisWorkbook is executed, WbkDest now gives access to ThisWorkbook . ThisWorkbook has a Name so ? WbkDest.Name ? WbkDest.Name will have a value. You are correct; you can rename the workbook without changing the code.

Set RngDest = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious) where RngDest = Nothing in tip and nothing pops up in screen tip except -4123 for xlFormulas, and 1 for xlByRows, and 2 for xlPrevious.

I deduce from this you want to add new data to the bottom of data from previous runs of the macro. In my experience this is unusual but I included the code for this option just in case.

[ Note from OP: FYI, yes, the Master has headers and the data will be added below data that has been previously copied over via the macros.]

Response from TD to above note My code is more complicated than you need but includes the functionality you want. If the master worksheet is empty, the header row(s) and the data rows will be copied from the first source worksheet. Only the data rows will be copied from any other workbooks. If the master worksheet is NOT empty, only data rows are copied from the source worksheets.

xlFormulas, xlByRows and xlPrevious are Excel defined constants so the parameters for Find are meaningful names rather than strange numbers.

From the other statements listed, I deduce that the destination workbook is currently empty.

[ Note from OP: FYI, yes, the Master/destination wkbk has a header row in the 1st row, but is otherwise empty to begin with.]

Response from TD to above note See my last response.

Do While FileName <> "" And FileName <> WbkDest.Name where both FileName and WbkDest.Name = "MASTER.xlsm" in screen tip. F8 then jumps through the rest of the code to the end where With WshtDest .Cells.EntireColumn.AutoFit End With, etc.

At this point you have hit a bug in my code. I do not understand why my testing did not encounter this bug.

You need to ask: why has the loop exited? Why hasn't it repeated for the next file? If I leave out most of the code, you get:

Do While FileName <> "" And FileName <> WbkDest.Name
  ‘ Code to process interesting file
  FileName = Dir$
Loop  ' While FileName <> "" And FileName <> WbkDest.Name

FileName <> "" is True since FileName = “MASTER.xlsm” but FileName <> WbkDest.Name is False since “MASTER.xlsm” = WbkDest.Name. The end condition has been reached and the loop ends without checking any other files.

I should have written:

Do While FileName <> ""
  If FileName <> WbkDest.Name
    ‘ Code to process interesting file
  End If
  FileName = Dir$
Loop  ' While FileName <> ""

With this code, workbook “MASTER.xlsm” is ignored as required but the loop continues looking for further workbooks.

Amend the macro to match the revised structure and try again.

[ Note from OP: 2nd Error I received a Compile Error - Expected: Then or Go To, so I just added Then after If FileName <> WbkDest.Name, so it reads

If FileName <> WbkDest.Name Then
Set WbkSrc=Workbooks.Open (FolderPath & FileName)
'Rest of Code

Is this correct?]

Response from TD to above note Yes you are correct. I should have included the tested code rather than trying to create a summary.

[ Note from OP: 3rd error - After I added all of the edits, I ran the Compile VBA Project under Run and it said, Compile Error: Loop without Do', which I don't understand because the Loop I'm sure it is referring to is at the bottom and never had a 'Do' next to it. In other words, I'm not sure why it is raising an error now when it never had a 'Do'.]

Response from TD to above note Compile errors "Loop without Do", "Do without Loop", "If within End If", "End If without If", etc. can be confusing. Do loops, for loops and Ifs must be properly nested. If you fail to complete one structure completely, the compiler complains about the outer structure which is probably perfect. My guess, is you have not included the End If for the new If . When the compiler hits the Loop it is looking for the End If or the start of a nested structure. I have replaced my original code with my revised code which I have just tested again. You can copy the new code and update for your names. However, it may be better to work down your loop and match it against mine. My guess is you will find an End If in my code that is missing from yours.