2

Im importing alot of sheetnames from different files using this VBA:

Sub ImportSheets()

    Dim sPath As String
    Dim sFname As String
    Dim wBk As Workbook
    Dim wSht As Variant


    Application.EnableEvents = False
    Application.ScreenUpdating = False
    sPath = InputBox("Enter a full path to workbooks")
    ChDir sPath
    sFname = InputBox("Enter a filename pattern")
    sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
    wSht = InputBox("Enter a worksheet name to copy")
    Do Until sFname = ""
        Set wBk = Workbooks.Open(sFname)
        Windows(sFname).Activate
        Sheets(wSht).Copy After:=ThisWorkbook.Sheets(1)
       ActiveSheet.Name = ActiveSheet.Range("A9")
        wBk.Close False
        sFname = Dir()
    Loop
    ActiveWorkbook.Save
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Right now the net sheetname is whatever value that is written in A9, is there a way i can change that, so the sheet will be renamed to the filename it is imported from? Alternative solution could be to rename it "Import" & Suffix, however im not sure how to add the suffix 1-1000 ect.

Mikkel Astrup
  • 405
  • 6
  • 18

2 Answers2

3

In order to have the same name as the Excel file, then simply try this:

ActiveSheet.Name = wBk.Name

If you want to have the same name as the worksheet, from which you are copying, instead of ActiveSheet.Name = ActiveSheet.Range("A9"), this is the code you need:

ActiveSheet.Name = Worksheets(wSht).Name

It will take exactly the correct name. Or even ActiveSheet.Name = wSht, as far as you are specifying it exactly through the InputBox.


In general, before trying to copy the corresponding worksheet, you may check whether it exists and only do the copy if it is there. This is one way (see the link below for others) to do it:

If WorksheetExists(wSht) Then
    Sheets(wSht).Copy After:=ThisWorkbook.Sheets(1)
    ActiveSheet.Name = ActiveSheet.Range("A9")
End If

Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Not WorksheetFunction.IsErr(Evaluate("'" & sName & "'!A1"))
End Function

In order to get Import + counter, try something like this in your code:

Option Explicit

Public Sub TestMe()

    Dim importName As String
    Dim cnt

    Do Until cnt = 10
        cnt = cnt + 1
        importName = "Import" & cnt
        Debug.Print importName
    Loop

End Sub

Simply make sure that you always increment +1 the worksheet's name.

Vityata
  • 42,633
  • 8
  • 55
  • 100
  • Might want to validate the contents of `wSht` though: not everything is allowed in a sheet name. – Mathieu Guindon Feb 19 '18 at 15:57
  • @Mat'sMug - that seems like quite overwork, I would rather make a `try-catch` with a nice error message. – Vityata Feb 19 '18 at 16:24
  • 1
    Or that, yes. `On Error Resume Next` with an `Err.Number` check and a `MsgBox` in case of error works just as well, too. The point is just to *do something* about `wSht` possibly being invalid ;-) – Mathieu Guindon Feb 19 '18 at 16:29
  • @Mat'sMug - following the logic of the OP's code, the best case scenario is checking whether `wSht` exists in the Worksheets collection of the file from which he is copying. If it is there, then it is a valid worksheet's name. – Vityata Feb 19 '18 at 16:31
3

You have the workbook name as sFname. Peel off the extension and use that.

ActiveSheet.Name = left(sFname, instrrev(sFname, chr(46))-1)