0

Description: What I am try to do is allow user to select excel file via browse then copy data from sheet 3 in selected file and paste to current workbook sheet2 (which name is Raw data(STEP 1) ). From the result in the current workbook sheet2 I want to copy the data to a new sheet and want to rename the sheet base on their file name but not the full string but just the ending such as M 100P 1.

Example of my file name(just a dummy) & it contains almost 20 file is the folder:

abcd_19-10-10_17-26_efgh-ijkl-02_ww1_line0_M 100P 1
abcd_19-10-10_18-33_efgh-ijkl-02_ww1_line0_M 100P 16

For now I am using inputbox to rename the sheet, as my code below:

Private Sub OpenWorkBook_Click()

Dim myFile As Variant
Dim OpenBook As Workbook

Application.ScreenUpdating = False

myFile = Application.GetOpenFilename(Title:="Browse your file", FileFilter:="Excel Files(*.xls*),*xls*")
If myFile <> False Then
    Set OpenBook = Application.Workbooks.Open(myFile)
    OpenBook.Sheets(3).Range("A2:R3063").Copy
    ThisWorkbook.Worksheets("Raw data(STEP 1)").Range("A3").PasteSpecial xlPasteValues
    OpenBook.Close True

    ThisWorkbook.Sheets(3).Range("A9:O27").Copy
    myVal = InputBox("Enter Sheet Name")
    Sheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = myVal
    ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
    ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlPasteValues
    ThisWorkbook.ActiveSheet.Range("A1:O19").ColumnWidth = 10.8

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If

End Sub

Edited code

If myFile <> False Then
    Set OpenBook = Application.Workbooks.Open(myFile)
    OpenBook.Sheets(3).Range("A2:R3063").Copy
    WB.Worksheets(2).Range("A3").PasteSpecial xlPasteValues
    OpenBook.Close True

    WB.Sheets(3).Range("A9:O27").Copy

    With WB
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = myVal = Split(WB.Name, ".")(0)
    .ActiveSheet.Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
    .ActiveSheet.Range("A1").PasteSpecial xlPasteValues
    .ActiveSheet.Range("A1:O19").ColumnWidth = 10.8
    End With


    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If

Is there anyways to do that without using the inputbox?

Any help will be appreciate

Hilmi
  • 43
  • 9

2 Answers2

1

To add a sheet at the end and name it in one go, try something like:

Thisworkbook.Sheets.Add(After:=Thisworkbook.Sheets(Thisworkbook.Sheets.Count)).Name = "Your sheet name goes here"

As per your last question, I also mentioned it's best to set a workbook object and reference that:

Dim wb as Workbook: Set wb = ThisWorkbook

This will make the above code written much cleaner:

With wb
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Your sheet name goes here"
End with

To go a step further and get your current workbook name you can then use:

myVal = wb.Name 'Will get you with extension
myVal = Split(wb.Name, ".")(0) 'Will get you name without extension

And as mentioned in the comments you can then also implement some sort of counter. But as per your current code, there is no loop to do so with. The above comes down to:

Dim wb as Workbook: Set wb = ThisWorkbook

With wb
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = Split(wb.Name, ".")(0) & "Your counter goes here"
End with

And on a sidenote (also as per your last question) have a look at this post on SO to start improving your code drastically.

JvdV
  • 70,606
  • 8
  • 39
  • 70
  • to automate sheetname sheetname= sheetname& i ............here i is counter i=i+1 – Techie Oct 23 '19 at 08:46
  • @JvdV i got the sheet name "false" after follow your method. I have edit my code in my post for your reference – Hilmi Oct 23 '19 at 11:43
  • @Hilmi, please try again, there was a small typo in my code too that I corrected. I accidentely copy pasted your `myval` variable in there. – JvdV Oct 23 '19 at 11:54
  • @JvdV Yeah it rename the sheet using current workbook name, but what I want actually is get the name from ```myfile```(in my original code) and want rename the sheet as ```M 100P 1``` & etc. Sorry for the confusing – Hilmi Oct 23 '19 at 12:38
  • Then try to ammend/change the code with the hints I have given you. `Split(myfile.Name, ".")(0)` would give you the name of the `myfile` workbook. And you'll need to have some sort of counter to ammend with the 1 etc. – JvdV Oct 23 '19 at 12:40
  • @JvdV Thanks for your help. I will try later – Hilmi Oct 23 '19 at 13:20
1

Thanks to @JvdV,I made a revise on my code an upgrade it to

    Dim wbk, twb As Workbook, sPath As String, sFile As String, sName As String

    sPath = "C:\Users\mazman\Desktop\Hilmi\data Summary\"
    sFile = Dir(sPath & "*.xls*")

    Set twb = ThisWorkbook
    Application.ScreenUpdating = 0

    Do While sFile <> ""
        Set wbk = Workbooks.Open(sPath & sFile)

        With wbk
            sName = Split(Split(.Name, "_")(6), ".")(0)
            .Sheets(3).Copy after:=twb.Sheets(twb.Sheets.Count)
            .Close 0
        End With

        With twb
        .ActiveSheet.Name = sName
        .ActiveSheet.Range("A1:R1").RowHeight = 45
        .ActiveSheet.Range("A1:R1").WrapText = True
        .ActiveSheet.Range("A1:R1").Interior.ColorIndex = 15
        End With
        sFile = Dir()
    Loop
    Set wbk = Nothing
Hilmi
  • 43
  • 9
  • Good you got a new piece of code. You can improve a little by avoiding `ActiveSheet` too. Don't forget, if the post has helped you/answered your question. Consider to upvote/accept the answer. – JvdV Oct 25 '19 at 06:39