Hi,

The situation is, I have 25 excel files in my C:/ drive.

I need to copy first worksheet named as "Fullrecon" from all 25 excel files
into one excel file.

In the new file, I need to name each worksheet as one, two, three.. so on.

This task is very important for me. I am not so good at coding. Please help
me achieve this. Thanks a lot for the help.

Thanks
Boss

Changge XLSdirectory to match whatever directory you are using

Sub copysheets()

XLSDirectory = "C:\temp\test\"

Dim Runname As String
Dim Index As String

First = True
Do

If First = True Then
XLSFileName = Dir(XLSDirectory & "*.xls")
First = False
Else
XLSFileName = Dir()
End If

If XLSFileName < "" Then

Workbooks.Open Filename:=XLSDirectory & XLSFileName
Set oldbk = ActiveWorkbook
With ThisWorkbook
oldbk.Sheets("Fullrecon").Copy _
after:=.Sheets(.Sheets.Count)
.Sheets("Fullrecon").Name = "Sheet" & .Sheets.Count
oldbk.Close
End With
End If
Loop While XLSFileName < ""

End Sub

"Boss" wrote:

Hi,

The situation is, I have 25 excel files in my C:/ drive.

I need to copy first worksheet named as "Fullrecon" from all 25 excel files
into one excel file.

In the new file, I need to name each worksheet as one, two, three.. so on.

This task is very important for me. I am not so good at coding. Please help
me achieve this. Thanks a lot for the help.

Thanks
Boss

Hi Joel,

Thanks for the code, but it gave me a error.

Just FYI the 25 worksheets contain many worsheets, the first worksheet of
all is named as "fullrecon"

Please help me to finish the task.

Thanks
Boss


"Joel" wrote:

Changge XLSdirectory to match whatever directory you are using

Sub copysheets()

XLSDirectory = "C:\temp\test\"

Dim Runname As String
Dim Index As String

First = True
Do

If First = True Then
XLSFileName = Dir(XLSDirectory & "*.xls")
First = False
Else
XLSFileName = Dir()
End If

If XLSFileName < "" Then

Workbooks.Open Filename:=XLSDirectory & XLSFileName
Set oldbk = ActiveWorkbook
With ThisWorkbook
oldbk.Sheets("Fullrecon").Copy _
after:=.Sheets(.Sheets.Count)
.Sheets("Fullrecon").Name = "Sheet" & .Sheets.Count
oldbk.Close
End With
End If
Loop While XLSFileName < ""

End Sub

"Boss" wrote:

Hi,

The situation is, I have 25 excel files in my C:/ drive.

I need to copy first worksheet named as "Fullrecon" from all 25 excel files
into one excel file.

In the new file, I need to name each worksheet as one, two, three.. so on.

This task is very important for me. I am not so good at coding. Please help
me achieve this. Thanks a lot for the help.

Thanks
Boss

Joel,

It's working perfectly.
Its was my mistake "Full recon" has a space between.

I just changed the name. Its working perfectly.

Thanks a lot for your help.
I apologise for the confusion.

Thanks
Boss

"Boss" wrote:

Hi Joel,

Thanks for the code, but it gave me a error.

Just FYI the 25 worksheets contain many worsheets, the first worksheet of
all is named as "fullrecon"

Please help me to finish the task.

Thanks
Boss


"Joel" wrote:

Changge XLSdirectory to match whatever directory you are using

Sub copysheets()

XLSDirectory = "C:\temp\test\"

Dim Runname As String
Dim Index As String

First = True
Do

If First = True Then
XLSFileName = Dir(XLSDirectory & "*.xls")
First = False
Else
XLSFileName = Dir()
End If

If XLSFileName < "" Then

Workbooks.Open Filename:=XLSDirectory & XLSFileName
Set oldbk = ActiveWorkbook
With ThisWorkbook
oldbk.Sheets("Fullrecon").Copy _
after:=.Sheets(.Sheets.Count)
.Sheets("Fullrecon").Name = "Sheet" & .Sheets.Count
oldbk.Close
End With
End If
Loop While XLSFileName < ""

End Sub

"Boss" wrote:

Hi,

The situation is, I have 25 excel files in my C:/ drive.

I need to copy first worksheet named as "Fullrecon" from all 25 excel files
into one excel file.

In the new file, I need to name each worksheet as one, two, three.. so on.

This task is very important for me. I am not so good at coding. Please help
me achieve this. Thanks a lot for the help.

Thanks
Boss