cycle through n files

I've got a series of operations to do on n excel files
the directory is the same..the names of the files are
0001..0002...0003...0004..until 0067
How can I do that through a macro??

Hi

I have examples here
http://www.rondebruin.nl/tips.htm

If you need help post back

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Rossella" <[email protected]> wrote in message news:[email protected]...
> I've got a series of operations to do on n excel files
> the directory is the same..the names of the files are
> 0001..0002...0003...0004..until 0067
> How can I do that through a macro??
>

the problem is that files are 0001..0002..and so on until 0100.

> the problem is that files are 0001..0002..and so on until 0100.

Why problem ?

The code examples loop through all files in the folder

Wat do you want to do?

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Rossella" <[email protected]> wrote in message news:[email protected]...
> the problem is that files are 0001..0002..and so on until 0100.
>

I've got files I don't want to cycle into..

I've got files I don't want to cycle into..

Give more information

Which files not?


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Rossella" <[email protected]> wrote in message news:[email protected]...
> I've got files I don't want to cycle into..
>

Files that are not 0001 ..0002 ..

Try this

If the first four characters are numeric it use the file in the loop
It use the folder C:\Data

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
rnum = 1

Do While FNames <> ""
If IsNumeric(Left(FNames, 4)) Then
Set mybook = Workbooks.Open(FNames)
'Your code
MsgBox FNames
mybook.Close False
End If

FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub




--
Regards Ron de Bruin
http://www.rondebruin.nl


"Rossella" <[email protected]> wrote in message news:[email protected]...
> Files that are not 0001 ..0002 ..
>

thanks..I'll try this at home tonight

thanks..I'll try this at home tonight

is this right?
Sub Prova()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourcerange As Range
Dim destrange As Range
Dim rnum As Long
Dim sourceRcount As Long
Dim Fnames As String
Dim mypath As String


Dim SaveDrivedir As String
SaveDrivedir = CurDir
mypath = "C:\prova"
ChDrive mypath
ChDir mypath

Fnames = ("*.xls")
If Len(Fnames) = 0 Then
MsgBox "Non ci sono file nella directory"
ChDrive SaveDrivedir
ChDir SaveDrivedir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
rnum = 1

Do While Fnames <> ""
If IsNumeric(Left(Fnames, 4)) Then
Selection.Copy
Set mybook = Workbooks.Open(Fnames)
Sheets("Febbraio").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Gennaio").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Marzo").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWorkbook.Save

MsgBox Fnames
mybook.Close False
End If

Fnames = Dir()
Loop
ChDrive SaveDrivedir
ChDir SaveDrivedir
Application.ScreenUpdating = True
End Sub

You want to copy the selection to all workbooks in the folder where the first
four characters are numeric.

Then Try this with a few test files in a folder

see also
http://www.rondebruin.nl/copy4.htm


Sub Prova_test1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim Fnames As String
Dim mypath As String
Dim rng As Range
Dim SaveDrivedir As String

SaveDrivedir = CurDir
mypath = "C:\prova"
ChDrive mypath
ChDir mypath

Fnames = ("*.xls")
If Len(Fnames) = 0 Then
MsgBox "Non ci sono file nella directory"
ChDrive SaveDrivedir
ChDir SaveDrivedir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

Set rng = Selection

Do While Fnames <> ""
If IsNumeric(Left(Fnames, 4)) Then

Set mybook = Workbooks.Open(Fnames)

rng.Copy mybook.Sheets("Febbraio").Range("A1")
rng.Copy mybook.Sheets("Gennaio").Range("A1")
rng.Copy mybook.Sheets("Marzo").Range("A1")

mybook.Close True 'save the file
End If

Fnames = Dir()
Loop
ChDrive SaveDrivedir
ChDir SaveDrivedir
Application.ScreenUpdating = True
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Rossella" <[email protected]> wrote in message news:[email protected]...
> is this right?
> Sub Prova()
> Dim basebook As Workbook
> Dim mybook As Workbook
> Dim sourcerange As Range
> Dim destrange As Range
> Dim rnum As Long
> Dim sourceRcount As Long
> Dim Fnames As String
> Dim mypath As String
>
>
> Dim SaveDrivedir As String
> SaveDrivedir = CurDir
> mypath = "C:\prova"
> ChDrive mypath
> ChDir mypath
>
> Fnames = ("*.xls")
> If Len(Fnames) = 0 Then
> MsgBox "Non ci sono file nella directory"
> ChDrive SaveDrivedir
> ChDir SaveDrivedir
> Exit Sub
> End If
>
> Application.ScreenUpdating = False
> Set basebook = ThisWorkbook
> rnum = 1
>
> Do While Fnames <> ""
> If IsNumeric(Left(Fnames, 4)) Then
> Selection.Copy
> Set mybook = Workbooks.Open(Fnames)
> Sheets("Febbraio").Select
> Range("A1").Select
> ActiveSheet.Paste
> Sheets("Gennaio").Select
> Range("A1").Select
> ActiveSheet.Paste
> Sheets("Marzo").Select
> Range("A1").Select
> ActiveSheet.Paste
> Application.CutCopyMode = False
> ActiveWorkbook.Save
> ActiveWindow.Close
> ActiveWorkbook.Save
>
> MsgBox Fnames
> mybook.Close False
> End If
>
> Fnames = Dir()
> Loop
> ChDrive SaveDrivedir
> ChDir SaveDrivedir
> Application.ScreenUpdating = True
> End Sub
>

thanks

I got an error message (error 5)
routine call not valid

I not test it and now I see you change the code from my first example

Use this

Fnames = Dir("*.xls")
If Len(Fnames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDrivedir
ChDir SaveDrivedir
Exit Sub
End If


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" <[email protected]> wrote in message news:[email protected]...
> You want to copy the selection to all workbooks in the folder where the first
> four characters are numeric.
>
> Then Try this with a few test files in a folder
>
> see also
> http://www.rondebruin.nl/copy4.htm
>
>
> Sub Prova_test1()
> Dim basebook As Workbook
> Dim mybook As Workbook
> Dim Fnames As String
> Dim mypath As String
> Dim rng As Range
> Dim SaveDrivedir As String
>
> SaveDrivedir = CurDir
> mypath = "C:\prova"
> ChDrive mypath
> ChDir mypath
>
> Fnames = ("*.xls")
> If Len(Fnames) = 0 Then
> MsgBox "Non ci sono file nella directory"
> ChDrive SaveDrivedir
> ChDir SaveDrivedir
> Exit Sub
> End If
>
> Application.ScreenUpdating = False
> Set basebook = ThisWorkbook
>
> Set rng = Selection
>
> Do While Fnames <> ""
> If IsNumeric(Left(Fnames, 4)) Then
>
> Set mybook = Workbooks.Open(Fnames)
>
> rng.Copy mybook.Sheets("Febbraio").Range("A1")
> rng.Copy mybook.Sheets("Gennaio").Range("A1")
> rng.Copy mybook.Sheets("Marzo").Range("A1")
>
> mybook.Close True 'save the file
> End If
>
> Fnames = Dir()
> Loop
> ChDrive SaveDrivedir
> ChDir SaveDrivedir
> Application.ScreenUpdating = True
> End Sub
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
> "Rossella" <[email protected]> wrote in message news:[email protected]...
>> is this right?
>> Sub Prova()
>> Dim basebook As Workbook
>> Dim mybook As Workbook
>> Dim sourcerange As Range
>> Dim destrange As Range
>> Dim rnum As Long
>> Dim sourceRcount As Long
>> Dim Fnames As String
>> Dim mypath As String
>>
>>
>> Dim SaveDrivedir As String
>> SaveDrivedir = CurDir
>> mypath = "C:\prova"
>> ChDrive mypath
>> ChDir mypath
>>
>> Fnames = ("*.xls")
>> If Len(Fnames) = 0 Then
>> MsgBox "Non ci sono file nella directory"
>> ChDrive SaveDrivedir
>> ChDir SaveDrivedir
>> Exit Sub
>> End If
>>
>> Application.ScreenUpdating = False
>> Set basebook = ThisWorkbook
>> rnum = 1
>>
>> Do While Fnames <> ""
>> If IsNumeric(Left(Fnames, 4)) Then
>> Selection.Copy
>> Set mybook = Workbooks.Open(Fnames)
>> Sheets("Febbraio").Select
>> Range("A1").Select
>> ActiveSheet.Paste
>> Sheets("Gennaio").Select
>> Range("A1").Select
>> ActiveSheet.Paste
>> Sheets("Marzo").Select
>> Range("A1").Select
>> ActiveSheet.Paste
>> Application.CutCopyMode = False
>> ActiveWorkbook.Save
>> ActiveWindow.Close
>> ActiveWorkbook.Save
>>
>> MsgBox Fnames
>> mybook.Close False
>> End If
>>
>> Fnames = Dir()
>> Loop
>> ChDrive SaveDrivedir
>> ChDir SaveDrivedir
>> Application.ScreenUpdating = True
>> End Sub
>>
>
>