ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Need help adjusting my code: (https://www.excelbanter.com/excel-programming/334323-need-help-adjusting-my-code.html)

HouseofRahl[_2_]

Need help adjusting my code:
 

Hi all,

Here is what I am trying to do, and what the result is:

I have a varying number of excel files in a folder. I need to make
each sheet in each file a sheet in a new file, so that I have one file
which has all of the info from all of the other files in this folder.

I have the following code, which does what I need, with one slight
problem. Any cells with text that are merged in the original sheets
does not copy over correctly.

For example, lets say I had a merged cell with 26 words in it, in the
newly created sheet, the words would cut off after say, the 11th word,
with the rest of the text just missing.

Here is the code I am using. (Code gotten from multiple sources, but
is not my own.)

Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "" -- Here I just have the path to
said folder
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub


Is there a command I could put in here to make sure that the formatting
and full text copy over?


I appreciate any help anyone can give.


--
HouseofRahl
------------------------------------------------------------------------
HouseofRahl's Profile: http://www.excelforum.com/member.php...o&userid=25161
View this thread: http://www.excelforum.com/showthread...hreadid=386590


STEVE BELL

Need help adjusting my code:
 
Worked fine for me in Excel 2000.

had to make sure that following was a single line so added the line
continuation _
WS.Copy
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)

WS.Copy _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)

--
steveB

Remove "AYN" from email to respond
"HouseofRahl"
wrote in message
...

Hi all,

Here is what I am trying to do, and what the result is:

I have a varying number of excel files in a folder. I need to make
each sheet in each file a sheet in a new file, so that I have one file
which has all of the info from all of the other files in this folder.

I have the following code, which does what I need, with one slight
problem. Any cells with text that are merged in the original sheets
does not copy over correctly.

For example, lets say I had a merged cell with 26 words in it, in the
newly created sheet, the words would cut off after say, the 11th word,
with the rest of the text just missing.

Here is the code I am using. (Code gotten from multiple sources, but
is not my own.)

Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "" -- Here I just have the path to
said folder
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub


Is there a command I could put in here to make sure that the formatting
and full text copy over?


I appreciate any help anyone can give.


--
HouseofRahl
------------------------------------------------------------------------
HouseofRahl's Profile:
http://www.excelforum.com/member.php...o&userid=25161
View this thread: http://www.excelforum.com/showthread...hreadid=386590





All times are GMT +1. The time now is 02:02 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com