Working code for data extraction - but one small error

[bandwidth]

Hey everyone! I was doing some googling for help with some data extraction and found a code that was actually provided on this forum some years ago and I tweaked it to fit my exact situation.

So the code below takes a column (and some other stuff) from multiple workbooks in the same folder and pastes it onto a master workbook. It's something like 1000 workbooks I'm dealing with. The code runs completely fine, except when I run it, every time it goes through a workbook, I get a pop-up asking if I want to save the changes made to the workbook (I then have to press Save/Don't Save/Cancel for the code to continue running). Seeing that I have 1000 workbooks, clicking 1000 times doesn't seem ideal.

Anyone have an idea how to rectify it? I feel like there's a simple solution, but I'm not too sure.

Sub runMerge()Dim fs As FileSystemObject
Dim targetPath As String
Dim haveTarget As Boolean
Dim thefile As File
Dim currRow As Long
Dim sourceFile As String
Dim a1 As String
Dim currCol As Long
Dim i As Integer




Dim starttime As Date
Dim endtime As Date


starttime = Now


haveTarget = False
Set fs = CreateObject("Scripting.FileSystemObject")
While Not haveTarget
    targetPath = InputBox("Result Folder", "Target Folder", "C:\Users\XianFang\Desktop\Rainwater Project\Test")
    haveTarget = fs.FolderExists(targetPath)
Wend
Set theFolder = fs.GetFolder(targetPath)
currCol = 2
For Each thefile In theFolder.Files
    If (InStr(1, thefile.Name, "xls", vbTextCompare) > 0 And Left(thefile.Name, 1) <> "~") Then
        Workbooks.Open thefile.Path
        sourceFile = ActiveWorkbook.Name
            For i = 2 To 148
                If Workbooks(sourceFile).Sheets("Daily").Cells(35, 1) = ThisWorkbook.ActiveSheet.Cells(i, 1) Then
                    
                    ThisWorkbook.ActiveSheet.Cells(1, currCol) = Workbooks(sourceFile).Sheets("Daily").Range("A3:A3").Value
                    ThisWorkbook.ActiveSheet.Range(Cells(i, currCol), Cells(148, currCol)) = Workbooks(sourceFile).Sheets("Daily").Range("B35:B150").Value
        
                    currCol = currCol + 1
                End If
            Next i
        Workbooks(sourceFile).Close
    End If
Next
endtime = Now




End Sub

Thanks, all!

 

[Michael M]

to not Save any changes, try

Workbooks(sourceFile).Close

TO



Workbooks(sourceFile) .Close savechanges:=False

 

[bandwidth]

Michael, I ran that for a small sample of workbooks and it worked like a charm!

Unfortunately, running it with the full amount of workbooks -- I think something like 1/6 of the way through the entire directory -- I get this error:

 

[Michael M]

Some options here...
One of them suggesting the failure might be at a protected workbook !!


VBA code of Excel 2013 is not working in Excel 2010

 

[bandwidth]

Ah, you're right! Tracked down the excel workbook that was giving me problems and turns out it's protected.

I'm trying to unprotect it, but every button under the "Review" tab is faded out (can't press them) except for "Show All Comments".

Just in case, I am using Excel 2010.

I could just leave this out for now and move on with finishing up the extraction, but I don't want to leave out a workbook just for convenience's sake.

 

[bandwidth]

That was silly, I just had to save the workbook as itself to get rid of it.

Thanks a bunch, Michael!