Data Import stopping after 16 rows

[grabrail]

I have some VBA code that imports data from one(or multiple) workbooks in a folder in a a central workbook. It works great adn imports the data I need. However I have come accross a weird problem.

When it has reach row 16, data stops importing, no errors or anything ( I turned off error handling in the code below to check) it seems to go through all the normal motions but just doesnt import anything after line 16.

Ive tested this by have 1 copy of the file in the folder, 3 copies, and even 16 copies. each time it imports the data from each file as i would expect until it reaches row 16, and then does nothing. Is there anything in the code below that is making this happen?

Public Sub ImportWorksheets()
   Const FOLDER_PATH = "D:\Documents\lmg\VI Sheet\Final\Database\import\"  'REMEMBER END BACKSLASH
   
   
   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim rowTarget As Long         'output row
   Dim ID As Integer
   
    Sheets(1).Range("B1").Select
        'get next blank cell
            While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Range("B1").Select
            Wend
        'input results
   
   rowTarget = ActiveCell.Row
   
   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub
   End If
   
   'reset application settings in event of error
   On Error GoTo errHandler
   Application.ScreenUpdating = False
   
   'set up the target worksheet
   Set wsTarget = Sheets(1)
   
   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH & "*.xlsm*")
   Do Until sFile = ""
      
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets(6) 'EDIT IF NECESSARY
      
      'import the data
      ID = rowTarget - 1
      With wsTarget
         .Range("A" & rowTarget).Value = ID
         .Range("B" & rowTarget).Value = wsSource.Range("B2").Value
         .Range("C" & rowTarget).Value = wsSource.Range("C2").Value
         .Range("D" & rowTarget).Value = wsSource.Range("D2").Value
         .Range("E" & rowTarget).Value = wsSource.Range("E2").Value
         .Range("F" & rowTarget).Value = wsSource.Range("F2").Value
         .Range("G" & rowTarget).Value = wsSource.Range("G2").Value
         .Range("H" & rowTarget).Value = wsSource.Range("H2").Value
         .Range("I" & rowTarget).Value = wsSource.Range("I2").Value
         .Range("J" & rowTarget).Value = wsSource.Range("J2").Value
         .Range("K" & rowTarget).Value = wsSource.Range("K2").Value
         .Range("L" & rowTarget).Value = wsSource.Range("L2").Value
         .Range("M" & rowTarget).Value = wsSource.Range("M2").Value
         .Range("N" & rowTarget).Value = wsSource.Range("N2").Value
         
         'optional source filename in the last column
         '.Range("N" & rowTarget).Value = sFile
      End With
      
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
   Loop
   
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
   
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End Sub




Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

 

[grabrail]

I think i know what is ahppening, when i go through the debug, the follow code runs .

 Sheets(1).Range("B1").Select
        'get next blank cell
            While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Range("B1").Select
            Wend

now I would expect this to start at cell b1, then move down to b2, then b3, etc until it finds a blank cell, due to the offset being set as (1,0)

but its not, it is stepping down 1 and accross 1, so selects, b1, c2, d3, etc until it gets to cell O14, where there is no data. then it imports, and effecively overwrites teh data in cell 14 and beyond.

So, how do I stop the offset stepping accross, and only move down?

 

[grabrail]

fixed it, set the offset to (1, -1)