Hi,
I've written this code original just to quickly pull information. Now I want to use it create a database so I don't want the old data to be deleted. I've added in the find last row function but it acts really weird. The first run, the summary is pulled with loads of empty rows. Then next time it finds the empty row no problem. Any help would be greatly appreciated.
Option Explicit
Sub CollateFromFiles()
' Open all .XLS in specific folder and import data(2007 compatible)
Dim vaDataValues As Variant
Dim strFileName As String
Dim strPath As String
Dim wbkOld As Workbook
Dim wbkNew As Workbook
Dim wksNew As Worksheet
Dim NR As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbkNew = ThisWorkbook
strPath = ActiveWorkbook.Path & "\XXXX\" ' folder with all files
strFileName = Dir(strPath & "*.xlsm")
unusedRow = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row 'Find first blank row.
NR = unusedRow
' Collate data from each file in the designated folder
Do While Len(strFileName) > 0
Set wksNew = wbkNew.Sheets("summary")
Set wbkOld = Workbooks.Open(strPath & strFileName) ' open file from folder
With wbkOld.Worksheets("XXXXX")
If .Range("ao34").Value <> vbNullString Then
vaDataValues = .Range("bp38:cs38").Value
wksNew.Range("aa" & NR & ":" & "bd" & NR).Value = vaDataValues
vaDataValues = .Range("bp42:cs42").Value
wksNew.Range("ay" & NR & ":" & "cb" & NR)Value = vaDataValues
vaDataValues = .Range("bp35:cs35").Value
wksNew.Range("cc" & NR & ":" & "df" & NR).Value = vaDataValues
NR = NR+ 1
ElseIf .Range("ao33").Value <> vbNullString Then
vaDataValues = .Range("bp37:cs37").Value
wksNew.Range("aa" & NR & ":" & "bd" & NR).Value = vaDataValues
vaDataValues = .Range("bp41:cs41").Value
wksNew.Range("ay" & NR & ":" & "cb" & NR)Value = vaDataValues
vaDataValues = .Range("bp34:cs345").Value
wksNew.Range("cc" & NR & ":" & "df" & NR).Value = vaDataValues
NR = NR+ 1
End If
End With
wbkOld.Close SaveChanges:=False
strFileName = Dir
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Thanks and regards
Christian
Bookmarks