Thanks Dave,
I ended up inserting the following line:
ActiveSheet.Name = Replace(ActiveWorkbook.Name, ".xls", "") & " (" & Format(Date, "mmddyy") & ")" '
Between:
Else
and
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
It worked for what I needed, because I only have 1 sheet in each of my workbooks that I was bringing in. All of my files were coming from an ERP system extract.
Regards,
Steve
--- In ExcelVBA@yahoogroups.com, "David Smart" <smartware.consulting@...> wrote:
>
> 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@...>
> 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