Hey All,

Just need a little help with some FSO stuff... Im trying to import some data from some files into a folder but it either doesnt copy the data or i just a rubbish result file...

Sub filefinder()
Dim fs As New FileSystemObject
Dim f As File
Dim fld As Folder
Dim LastRow1 As Integer
Dim LastRow As Integer
Dim wbS As Workbook 'The summary workbook
Dim wbR As Workbook 'The other workbooks will use this reference
Dim i As Integer 'Keep track of rows
Set wbS = Application.Workbooks.Add()
Set fld = fs.GetFolder("Q:\Past Data\2005")
LastRow = 1
i = 0
For Each f In fld.Files ' Each file
Set wbR = Application.Workbooks.Open(f.Path)
wbR.Sheets("Sheet1").Activate
With ActiveSheet
LastRow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

'Copy the first range
wbR.Sheets("Sheet1").Range(Cells(1, 1), Cells(LastRow1, 25)).Copy

'Paste the first range "as row". The range will be pasted from colum A to G
wbS.Sheets("Sheet1").Cells((LastRow), 1).PasteSpecial
'Close the file
Application.CutCopyMode = False
wbR.Close savechanges = False
LastRow = LastRow1
Set wbR = Nothing 'Set wbR to nothing and make it "ready" for the next file
Next f ' Next file
'Save the summary file
wbS.SaveAs ("Q:\Past Data\2005\summary.xls")
End Sub


Ive got a feeeling i keep mucking up this line here: wbS.Sheets("Sheet1").Cells((LastRow), 1).PasteSpecial any advice would be amazing ... once i get this working i can do the other years very very quickly

Cheers

Hi, Guirg,

maybe test like this:

With wbS.Sheets("Sheet1")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells((LastRow), 1).PasteSpecial
End With
Or even
With wbS.Sheets("Sheet1")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells((LastRow), 1).Resize(LastRow1, 25).Value = _
wbR.Sheets("Sheet1").Range(Cells(1, 1), Cells(LastRow1, 25)).Value
End With
I´d also set objects for the sheets as well.

Ciao,
Holger

Cheers for that, i manged to sort it ... it was pasting over itself :S ahahha im hopeless sometimes.... Another quick question that popped up when i looked over the summary... is there a way to say

For r = 1 To 499 Step 2
Cells(r, 2).Activate
If ActiveCell <> A numerical value or nothing Then
Rows(r).Select
Selection.Copy
Sheets("Sheet1").Activate
Cells(n + 1, 1).Select
ActiveSheet.Paste
n = n + 1
Sheets("Protocols").Select
Selection.Activate
end if
Next r

What i have are rows of numerical values with a row of text in one cell under the numerical row, but sometimes theres no text so it doubbles up so the simple solution of just copying every other cell goes out the window..... :(... any ideas?

Hi, Guirg,

IsEmpty (maybe with the use of Trim to get rid of spaces) or IsNumeric (please mind that Dates are considerd numeric as well)/IsText.

If IsEmpty(ActiveCell.Value) Or IsNumeric(activeCell.Value) Then
Ciao,
Holger

vielen danke! managed to get it working... sorta.... one last little bit of help needed and ill be done!!
Sub convertdates()
Dim strSeparator
Dim strTheMonth
Dim strTheYear
Dim strTheDay
Dim strFinalDate
Dim r As Integer
strSeparator = "."
For r = 1 To 6000
strTheMonth = Month(Cells(r, 1).Value)
strTheYear = Year(Cells(r, 1).Value)
strTheDay = Day(Cells(r, 1).Value)
strFinalDate = strTheDay & strSeparator & _
strTheMonth & strSeparator & _
strTheYear
Cells(r, 26).Value = strFinalDate
Next r
End Sub


It runs through fine november it has no problem.. hits december and i get a missmatch error .....grrrrrrr.... any ideas?

Hi, Guirg,

you want Strings in these cells? Otherwise you should consider DateSerial or CDate. Sorry but at the moment I don´t have a clue why November does fine and December just causes a runtime error.

Ciao,
Holger

ha ha german spelling versus the english ....