如何打开保存在特定位置的 Excel 文件，使用 VBA 从工作表中的最后一个选项卡创建一个新选项卡

Question

I am not from software background and trying to write a macro to avoid repeated work that causes errors. Please feel free to suggest things that will make it better.I tried to pull pieces from different program from this site and make it work.

Thank you in advance.

Here is what I am trying to do. a) I am trying to open Excel file(lets say file 2) saved at specific location from current file (Say file 1). Works

b) Create a new tab in file 2 same as last tab in that file, Works

c) Re-name the created tab using 2 different cell from file 1.(Auto Rename would be good based on file 1 cells but I could only manage pop up that ask me to enter but doesn't rename the file). Doesn't Work/partially work

d) Pop up to input Name and 2 more input in different cells(I can only get Your name how can I get 3 input in 3 different cells) Doesn't Work/partially work

e) Copy 2 cells from file 1 and copy in file 2 newly created tab. Doesn't work

Here is the code I tried to write.

Sub Filling_List()
Dim sPath As String, sFile As String, wb As Workbook, i As Integer

'Application.ScreenUpdating = False

sPath = "C:\Users\aricsonp\Desktop\Filling list macro\"
sFile = sPath & "ArF Filling List.xlsm"

Set wb = Workbooks.Open(sFile)

ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = InputBox("New Name:")
If sName = "" Then Exit Sub

ActiveSheet.cell(3, "E") = InputBox("Your Name:")

' With ActiveSheet.Sheets("ArF Filling List (7)")
'.Range("B03").Value = uploader.Sheets("Que & Tsc Cal").Range("B02").Value
' .Range("B05").Value = uploader.Sheets("Que & Tsc Cal").Range("B01").Value
' End With


'Application.ScreenUpdating = True


End Sub

Answer 1

Here are some pointers.

1) Put Option Explicit at top so syntax and declarations are checked. This would force you to declare sName and uploader as well as set their values. i is also declared but not assigned.

2) Your code, as is, did rename the sheet . You assigned directly to the newly added sheet from the inputbox rather than storing in a variable.

Worksheets(Worksheets.Count).Name = InputBox("New Name:")

Assuming the variable sName was actually to hold this and that you want to grab this value from 2 cells in the workbook containing the code (ie ThisWorkbook ) you are running:

sName = ThisWorkbook.Worksheets("Sheet1").Range("A1") & ThisWorkbook.Worksheets("Sheet1").Range("B1")

You would probably want to declare and assign ThisWorkbook and worksheets you reference within as variables.

eg

Dim wb1 as Workbook
Dim ws1 as Worksheet 
Set wb1 = ThisWorkbook 
Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'change as appropriate

3) Avoid mixing Sheets and Worksheets collections. I prefer Worksheets collections unless you have Chart sheets present.

4) In most cases you will want to compare against vbNullstring rather than an empty string literal (""). It is faster to assign, uses less memory etc.

If sName = vbNullString Then Exit Sub 

5) Assigning more values to cells; add more inputboxes AND use Cells not Cell eg

ActiveSheet.Cells(4, "E") = InputBox("Your Age:")

6) Adding more cells' values into the newly opened workbook, newly added sheet; use your wb and sName variables to ensure correct targeting:

With wb.Worksheets(sName)

7) You may want to declare each variable at the top on its own line ie avoid multiple declarations on one line. Makes it easier to debug and spot any implicit variants.

So, you might have something like the following:

Option Explicit

Public Sub Filling_List()

Dim sPath As String
Dim sFile As String
Dim wb As Workbook
'  Dim i As Integer ''not used
Dim sName As String 'add sName declaration
'Add declaration for uploader variable and set its value
Dim wb1 as Workbook
Dim ws1 as Worksheet 

Set wb1 = ThisWorkbook 
Set ws1 = ThisWorkbook.Worksheets("Sheet1")

Application.ScreenUpdating = False

sPath = "C:\Users\aricsonp\Desktop\Filling list macro\"
sFile = sPath & "ArF Filling List.xlsm"

Set wb = Workbooks.Open(sFile)

ActiveSheet.Copy After:=Worksheets(Worksheets.Count)

'Worksheets(Worksheets.Count).Name = InputBox("New Name:")

sName = ws1.Range("A1") & ws1.Range("B1") 'assign value from two cells

ActiveSheet.Name = sName

If sName = vbNullString Then Exit Sub 'compare against vbNullstring not empty string literal

With wb.Worksheets(sName)

    .Cells(3, "E") = InputBox("Your Name:")
    .Cells(4, "E") = InputBox("Your Age:")
    .Cells(5, "E") = InputBox("Your Occupation:")
    .Range("B03") = uploader.Worksheets("Que & Tsc Cal").Range("B02").Value2
    .Range("B05") = uploader.Worksheets("Que & Tsc Cal").Range("B01").Value2

End With

Application.ScreenUpdating = True

End Sub