FSO Help

[Guirg]

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

 

[HaHoBe]

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

 

[Guirg]

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
[B]        If ActiveCell <> A numerical value or nothing Then
[/B]        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?

 

[HaHoBe]

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

 

[Guirg]

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?

 

[HaHoBe]

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

 

[Guirg]

ha ha german spelling versus the english ....