excel - 使用单元格值作为工作表名称

Question

我想将数据从工作簿粘贴到另一个工作簿到具有单元格值名称的工作表中。我不知道这是否可能，但我正在为此苦苦挣扎，我在互联网上找不到类似的东西。

到目前为止，这是我的代码：

'This creates a sheet from a range and gives it the name of the cell so it can be from 5 to 10 sheets'

For Each Cell In Range("G5:G15")
    If Cell.Value <> "" Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Cell.Value
    End If
Next

在其他不重要的代码之后，我做了这个：

Dim AutoFilterRng As Range
Dim WorksheetName As String

For Each Cell In Range("H5", Range("H5").End(xlDown))
    If Cell.Value <> "" Then
        WorksheetName = Cell.Offset(0, -1).Value    
        Workbooks.Open MJFile                    'Opens the file where data I want to copy
        ActiveSheet.Range("A:U").AutoFilter Field:=12, Criteria1:="*" & Cell.Value    'Filters depending on the cell value
        With ActiveSheet.AutoFilter.Range
            Set AutoFilterRng = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        End With
        ActiveSheet.AutoFilter.Range.Offset(1, 0).Resize(ActiveSheet.AutoFilter.Range.Count - 1).Copy
        Workbooks.Open WBOR    'Opens the Workbook where I want to paste data
        Worksheets(WorksheetName).Range("A1").Paste    'This gives an  error and it is where I would like to paste my data
        Workbooks.Open MJFile
        AutoFilterMode = False
    End If
Next

非常感谢您提前

如果您想查看整个代码：

Sub AddTO()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.EnableEvents = False
'------------------------------------------------------------------------------------------------------------------------------------------------------'

'Open TO FIle'

Dim WBOR As String
Dim MJFile As String
Dim TOFile As String
Dim Path As String

WBOR = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

'On Error GoTo Fin
MsgBox "Choose Bear File"
With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Clear
    .AllowMultiSelect = False
    If .Show = -1 Then
        TOFile = .SelectedItems(1)
    End If
End With

Workbooks.Open TOFile

'Filter Bear File to Only Necessary TO'
Dim NameRng As Range
Dim TORng As Range
Dim DeliveryWeek As String
Dim i As Long

Workbooks.Open WBOR
Set NameRng = Worksheets("Tasks_Orders_Info").Range("E5", Range("E5").End(xlDown))
Workbooks.Open TOFile
Set TORng = Worksheets("WS Lead Plan1").Range("G2", Range("G2").End(xlDown))
Workbooks.Open WBOR
DeliveryWeek = "*Week_" & Worksheets("Tasks_Orders_Info").Range("C5").Value & "*"

Workbooks.Open TOFile
For i = TORng.Count To 1 Step -1
    Select Case True
        Case TORng.Cells(i) Like DeliveryWeek
        Case Else
            TORng.Cells(i).EntireRow.Delete
    End Select
Next i

'Add TO to MJ File'
Workbooks.Open WBOR
TORng.Copy
Worksheets("Tasks_Orders_Info").Range("G5").PasteSpecial xlPasteValues
Worksheets("Tasks_Orders_Info").Range("G5").End(xlDown).PasteSpecial xlPasteValues

Workbooks.Open TOFile
ActiveWorkbook.Close SaveChanges:=False

Range("H5:H15") = "=IF(ISERR(FIND("" "",Table2[@Coder])),"""",LEFT(Table2[@Coder],FIND("" "",Table2[@Coder])-1))"
Range("I5:I15") = "=MID(Table2[@Coder],SEARCH("" "",Table2[@Coder],1)+1,SEARCH("" "", Table2[@Coder],SEARCH("" "",Table2[@Coder],1)+1)-SEARCH("" "",Table2[@Coder],1))"
Range("J5:J15") = "=IFERROR(MID(Table2[@Coder],FIND("" "",Table2[@Coder],FIND("" "",Table2[@Coder])+1)+1,FIND("" "",Table2[@Coder],FIND("" "",Table2[@Coder],FIND("" "",Table2[@Coder])+1)+1)-FIND("" "",Table2[@Coder],FIND("" "",Table2[@Coder])+1)-1),"""")"

Form1 = "=IF(OR(ISNUMBER(FIND(H5,G5,1)),ISNUMBER(FIND(I5,G5,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G5,1)))),LEFT(G5,FIND(""  "",G5,1)-3),IF(OR(ISNUMBER(FIND(H5,G6,1)),ISNUMBER(FIND(I5,G6,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G6,1)))),LEFT(G6,FIND(""  "",G6,1)-3),IF(OR(ISNUMBER(FIND(H5,G7,1)),ISNUMBER(FIND(I5,G7,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G7,1)))),LEFT(G7,FIND(""  "",G7,1)-3),IF(OR(ISNUMBER(FIND(H5,G8,1)),ISNUMBER(FIND(I5,G8,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G8,1)))),LEFT(G8,FIND(""  "",G8,1)-3),IF(OR("
Form2 = "ISNUMBER(FIND(H5,G9,1)),ISNUMBER(FIND(I5,G9,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G9,1)))),LEFT(G9,FIND(""  "",G9,1)-3),IF(OR(ISNUMBER(FIND(H5,G10,1)),ISNUMBER(FIND(I5,G10,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G10,1)))),LEFT(G10,FIND(""  "",G10,1)-3),IF(OR(ISNUMBER(FIND(H5,G11,1)),ISNUMBER(FIND(I5,G11,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G11,1)))),LEFT(G11,FIND(""  "",G11,1)-3),IF(OR(ISNUMBER(FIND(H5,G12,1)),ISNUMBER(FIND(I5,G12,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G12,1)))),LEFT(G12,FIND(""  "",G12,1)-3),IF("
Form3 = "OR(ISNUMBER(FIND(H5,G13,1)),ISNUMBER(FIND(I5,G13,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G13,1)))),LEFT(G13,FIND(""  "",G13,1)-3),IF(OR(ISNUMBER(FIND(H5,G14,1)),ISNUMBER(FIND(I5,G14,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G14,1)))),LEFT(G14,FIND(""  "",G14,1)-3),IF(OR(ISNUMBER(FIND(H5,G15,1)),ISNUMBER(FIND(I5,G15,1)),IF(J5="""",FALSE,ISNUMBER(FIND(J5,G15,1)))),LEFT(G15,FIND(""  "",G15,1)-3),""NOT FOUND"")))))))))))"
Range("B5", Range("B5").End(xlDown)) = Form1 + Form2 + Form3

Range("B5", Range("B5").End(xlDown)).Copy
Range("B5", Range("B5").End(xlDown)).PasteSpecial xlPasteValues
Range("G5", Range("G5").End(xlDown)).ClearContents

'Create New Sheets"
Range("G5:G15") = "=IFERROR(CONCAT(RIGHT(Table2[@[TASK ORDER]],LEN(Table2[@[TASK ORDER]])-SEARCH("" TO"",Table2[@[TASK ORDER]],1)),""_"",H5),"""")"
Range("G5:G15").Copy
Range("G5:G15").PasteSpecial xlPasteValues

Range("H5", Range("H5").End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Delete

For Each Cell In Range("G5:G15")
    If Cell.Value <> "" Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Cell.Value
    End If
Next

Worksheets("Tasks_Orders_Info").Activate

'Open MJ File'
MsgBox "Choose mj extraction"
With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Clear
    .AllowMultiSelect = False
    If .Show = -1 Then
        MJFile = .SelectedItems(1)
    End If
End With

Workbooks.Open MJFile

'Delete non Users'
Dim mapjobdata As Range
Dim WorkUserRg As Range

Worksheets("map_jobs_-_feedback_and_observa").Range("A1").Select
Worksheets("map_jobs_-_feedback_and_observa").Range(Selection, Selection.End(xlDown)).Select
Worksheets("map_jobs_-_feedback_and_observa").Range(Selection, Selection.End(xlToRight)).Select

Set mapjobdata = Worksheets("map_jobs_-_feedback_and_observa").Range(Selection.Address)
Set WorkUserRg = mapjobdata.Find("Worked on by User", , xlValues, xlWhole, , , True).Offset(1, 0)
Set WorkUserRg = Worksheets("map_jobs_-_feedback_and_observa").Range(WorkUserRg, WorkUserRg.End(xlDown))

For i = WorkUserRg.Count To 1 Step -1
    If WorkUserRg.Cells(i) Like "*@email.com*" Then
        Else
            WorkUserRg.Cells(i).EntireRow.Delete
    End If
Next i

'Add MapJobs to each Sheet'
Workbooks.Open WBOR
Range("H5:H15") = "=IFERROR(RIGHT(Table2[@Coder],FIND("")"",Table2[@Coder],1)-(FIND("" ("",Table2[@Coder],1))),"""")"
Range("H5", Range("H5").End(xlDown)).Copy
Range("H5", Range("H5").End(xlDown)).PasteSpecial xlPasteValues

Dim AutoFilterRng As Range
Dim WorksheetName As String

For Each Cell In Range("H5", Range("H5").End(xlDown))
    If Cell.Value <> "" Then
        WorksheetName = Cell.Offset(0, -1).Value
        Workbooks.Open MJFile
        ActiveSheet.Range("A:U").AutoFilter Field:=12, Criteria1:="*" & Cell.Value
        With ActiveSheet.AutoFilter.Range
            Set AutoFilterRng = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        End With
        ActiveSheet.AutoFilter.Range.Offset(1, 0).Resize(ActiveSheet.AutoFilter.Range.Count - 1).Copy
        Workbooks.Open WBOR
        Worksheets(WorksheetName).Range("A1").Paste
        Workbooks.Open MJFile
        AutoFilterMode = False
    End If
Next

'------------------------------------------------------------------------------------------------------------------------------------------------------'
Fin:
Application.EnableEvents = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub

这是我得到的错误，调试显示下一行：

标签： excelvba

Answer 1

这不是答案，但可以帮助您：

Sub test()

    Dim shtName As String

    With ThisWorkbook

        'Let assume that the sheet name we want appears in Sheet3, range A1
        'Get sheet name
        shtName = .Worksheets("Sheet3").Range("A1").Value
        'Activate sheet with name shtName
        .Worksheets(shtName).Activate

    End With

End Sub