You might find it easier to change the name of WS before you copy it to the
summary workbook. Presumably just
WS.Name = whatever name you want it to have.
However ...
This code copies all the worksheets from a workbook, not just one, so naming
the worksheets after the workbook file name is not going to work for the
second and subsequent worksheets in a workbook. You'll need to use a
counter and append a number.
Also, there are limitations to what can go into a worksheet name. In
particular, the length is severely limited (31 characters springs to mind).
So, you'll need a very controlled set of file names to start with, or some
form of summarising code to make longer file names manageable.
Regards, Dave S
----- Original Message -----
From: "sspatriots" <sspatriots@yahoo.com>
To: <ExcelVBA@yahoogroups.com>
Sent: Thursday, September 15, 2011 6:53 AM
Subject: [ExcelVBA] Merging Workbooks in a Folder Macro...but need a bit of
a twist to it.
> I've found the code below online that will grab all the workbooks in a
> selected folder and merge them all into one. However, I need one that will
> use the file name of the workbooks bring merged as the new worksheet name
> (minus the file extensions). Have no clue on how to make this happen or if
> someone already had code that will do this that I can try.
>
>
> Thanks,
>
> Steve
>
> Sub CombineFiles()
> Dim path As String
> Dim FileName As String
> Dim LastCell As Range
> Dim Wkb As Workbook
> Dim WS As Worksheet
> Dim ThisWB As String
>
> ThisWB = ThisWorkbook.Name
> Application.EnableEvents = False
> Application.ScreenUpdating = False
> path = GetDirectory
> FileName = Dir(path & "\*.xls", vbNormal)
> Do Until FileName = ""
> If FileName <> ThisWB Then
> Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
> For Each WS In Wkb.Worksheets
> Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
> If LastCell.Value = "" And LastCell.Address =
> Range("$A$1").Address Then
> Else
> WS.Copy
> After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
> End If
> Next WS
> Wkb.Close False
> End If
> FileName = Dir()
> Loop
> Application.EnableEvents = True
> Application.ScreenUpdating = True
>
> Set Wkb = Nothing
> Set LastCell = Nothing
> End Sub
>
>
>
>
> ------------------------------------
>
> ----------------------------------
> Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go
> here: http://www.mousetrax.com/techtrax to enter the ezine, then search
> the ARCHIVES for EXCEL VBA.
>
> ----------------------------------
> Visit our ExcelVBA group home page for more info and support files:
> http://groups.yahoo.com/group/ExcelVBA
>
> ----------------------------------
> More free tutorials and resources available at:
> http://www.mousetrax.com
>
> ----------------------------------Yahoo! Groups Links
>
>
>
>
>
> -----
> No virus found in this message.
> Checked by AVG - www.avg.com
> Version: 10.0.1392 / Virus Database: 1520/3895 - Release Date: 09/13/11
>
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Tidak ada komentar:
Posting Komentar