Excel 使用单元格值作为工作表名称_Excel_Vba

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

excel vba

Excel 使用单元格值作为工作表名称,excel,vba,Excel,Vba,我想将工作簿中的数据粘贴到另一个工作簿中，粘贴到具有单元格值名称的工作表中。我不知道这是否可能，但我正在努力解决这个问题，我在互联网上找不到类似的东西这是我目前的代码： '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 <>

我想将工作簿中的数据粘贴到另一个工作簿中，粘贴到具有单元格值名称的工作表中。我不知道这是否可能，但我正在努力解决这个问题，我在互联网上找不到类似的东西

这是我目前的代码：

'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

“这将从一个范围创建一个工作表，并为其提供单元格名称，使其可以是5到10个工作表”
对于范围内的每个单元格（“G5:G15”）
如果单元格的.Value为“”，则
Sheets.Add（之后：=Sheets（Sheets.Count））.Name=Cell.Value
如果结束
下一个

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

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

Dim自动筛选作为范围
Dim工作表名称为字符串
对于范围（“H5”，范围（“H5”）。结束（xlDown））
如果单元格的.Value为“”，则
工作表名称=单元格偏移量（0，-1）.Value
工作簿.Open MJFile'打开要复制数据的文件
ActiveSheet.Range（“A:U”）.AutoFilter字段：=12，Criteria1:=“*”&Cell.Value”根据单元格值进行筛选
使用ActiveSheet.AutoFilter.Range
设置AutoFilterRng=.Offset（1，0）。调整大小（.Rows.Count-1，1）。特殊单元格（xlCellTypeVisible）
以
ActiveSheet.AutoFilter.Range.Offset（1，0）。调整大小（ActiveSheet.AutoFilter.Range.Count-1）。复制
“工作簿.打开WBOR”打开要粘贴数据的工作簿
工作表（WorksheetName）.Range（“A1”）.Paste'这会给出一个错误，我想在这里粘贴数据
工作簿。打开文件
AutoFilterMode=False
如果结束
下一个

事先非常感谢

如果要查看整个代码，请执行以下操作：

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

Sub AddTO（）
Application.Calculation=xlManual
Application.ScreenUpdating=False
Application.EnableEvents=False
'------------------------------------------------------------------------------------------------------------------------------------------------------'
“打开文件”
将WBOR变暗为字符串
将文件设置为字符串
像绳子一样变暗
将路径设置为字符串
WBOR=ActiveWorkbook.Path&“\”&ActiveWorkbook.Name
'错误转到Fin
MsgBox“选择熊文件”
使用Application.FileDialog（msoFileDialogFilePicker）
.过滤器
.AllowMultiSelect=False
如果.Show=-1，则
TOFile=.SelectedItems（1）
如果结束
以
工作手册。打开文件
'将文件筛选为仅对必需'
Dim NameRng As范围
变暗托邦As射程
Dim DeliveryWeek作为字符串
我想我会坚持多久
工作簿。打开WBOR
Set NameRng=工作表（“任务\订单\信息”）。范围（“E5”，范围（“E5”）。结束（xlDown））
工作手册。打开文件
设置TORng=工作表（“WS-Lead Plan1”）。范围（“G2”，范围（“G2”）。结束（xlDown））
工作簿。打开WBOR
DeliveryWeek=“*周”&工作表（“任务\订单\信息”）.范围（“C5”）.值和“*”
工作手册。打开文件
对于i=TORng，计数为1步-1
选择Case True
Case TORng.Cells（i）喜欢每周交货
其他情况
TORng.Cells（i）.EntireRow.Delete
结束选择
接下来我
“添加到MJ文件”
工作簿。打开WBOR
托恩，收到
工作表（“任务、订单、信息”）.范围（“G5”）.粘贴特殊XLPaste值
工作表（“任务\订单\信息”）.范围（“G5”）.结束（xlDown）.粘贴特殊xlPasteValues
工作手册。打开文件
ActiveWorkbook.Close SaveChanges:=False
范围（“H5:H15”）=“=IF（ISER（查找（“”），表2[@Coder]），“”，左（表2[@Coder]，查找（“”），表2[@Coder]）-1）”
范围（“I5:I15”）==MID（表2[@Coder]，搜索（“”），表2[@Coder]，1）+1，搜索（“”），表2[@Coder]，搜索（“”），表2[@Coder]，1）+1）-搜索（“”，表2[@Coder]，1））”
范围（“J5:J15”）==IFERROR（MID（表2[@Coder]，查找（“”），表2[@Coder]，查找（“”），表2[@Coder]）+1）+1，查找（“”），表2[@Coder]，查找（“”），表2[@Coder]，查找（“”），表2[@Coder]）+1）+查找（“”），表2[@Coder]，查找（“”），查找（“”），表2[@Coder]）+1），“”）
（五，G5，G5，G5，G5，1）（1），如果（若）若（J5=”，假，若（J5）假若，假若，假若数字（发现（J5，G5，G5，G5，G5，G5，1））），左（G5，左（G5，左（G5，左（找到）左（G5，找到（（““，找到（“，G5，找到（“”””，G5，找到（“，G5，5，5，1）、1-3）、1-3）、3）、3）、若（或（或（或（或（找到（找到（找到（H5（H5（H5，G5，G6，G6，G6，6，6，1）、1）、1）））、1）））、若）若）若）若（或（或（或（或（或（或（或（或）数字），若（或（或（找到（H5（找到（H5（H5（H5（H5（H5（H5（H5是的，ISNUMBER（查找（J5，G7,1））），左（G7，FIND（“”），G7,1）-3），如果（或（ISNUMBER（FIND（H5，G8,1）），ISNUMBER（FIND（I5，G8,1）），如果（J5=“”），FALSE，ISNUMBER（FIND（J5，G8,1）），左（G8，FIND（“”，G8,1）-3），如果（或（“”）
（五，G9，G9，G9，1）（1））、左（G9，G9，1）左（G9，找到找到找到（5，G5，G9，1），左（G9，找到（找到（5，G5，G9，1），左（G9，找到（发现（H5，G9，G9，1），3），若（或（或（或）数字（发现（发现（发现（H5，G10，10，10，10，10，10，10，10，10，1），1），1），1），若）数字（发现（发现（发现（5，5，5，5，5，10，10，5，10，10，10，10，10，10，10，10，10，10，10，10，10，1），1），1），1），1），1），1），若，1），若（若（若，5，5，5，5，5，5，5，5，5，5，5，5，5，5，5，5（J5，G11,1））），左（G11，FIND（“”，G11,1）-3），如果（或（ISNUMBER（FIND（H5，G12,1）），ISNUMBER（FIND（I5，G12,1）），如果（J5=“”），FALSE，ISNUMBER（FIND（J5，G12,1）），左（G12，FIND（“”，G12,1）-3），如果（“”）
（5，G13，G13，1，1），如果（若）若（J5=”，假若，假若，假若，假若数字（发现（5，G15，G13，1 3，1），左（G13，找到（5，G13，1），左（G13，找到（3，找到（“、3，1，3，1），左（G13，找到，找到（3，找到（（“、3，1，3，3，1），3），3），3），3），若（或（或（或（或）数字（或（数字（找到（找到（找到（找到（找到（H5（H5，5，4，4，4，4，14，1），1），1），1），1），1），1），3，1），3，1），3，1），若），若），若），若），若）若）若）若（或（或（或（或（或（找到（找到（找到（找到（找到（找到（找到（找到（H5，（H5（H5（H5（H5（FIND（J5，G15,1））），左（G15，FIND（“”，G15,1）-3），“未找到”（“”）；“”）；“”）
范围（“B5”，范围（“B5”）。结束（xlDown））=Form1+Form2+Form3
范围（“B5”，范围（“B5”）。结束（xlDown））。复制
范围（“B5”，范围（“B5”）.End（xlDown））.paste特殊xlpaste值
范围（“G5”，范围（“G5”）.End（xlDown））.ClearContents
“创建新工作表”
范围（“G5:G15”）=“=IFERROR（CONCAT（右（表2[@[任务顺序]））、LEN（表2[@[任务顺序]））-搜索（““至”，“表2[@[任务顺序]”），1））、“”，“H5”）、“）
范围（“G5:G15”）。副本
范围（“G5:G15”）。粘贴特殊XLPaste值
范围（“H5”，范围（“H5”）。结束（xlDown））。选择
范围（选择，选择.结束（xlToRight））.Delete
对于范围内的每个单元格（“G5:G15”）
如果单元格的.Value为“”，则
Sheets.Add（之后：=Sheets（Sheets.Count））.Name=Cell.Value
如果结束
下一个
工作表（“任务、订单、信息”）。激活
“打开MJ文件”
MsgBox“选择mj extracti”
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

Sub sheetsAddAndCopy()
Dim WBOR As Workbook, Wmjf As Workbook, shW As Worksheet, shMJ As Worksheet
Dim AutoFilterRng As Range, WorksheetName As String, cell As Range

Const MJFile As String = "your workbook full path"
Set WBOR = ThisWorkbook
Set Wmjf = Workbooks.Open(MJFile) 'Opens the file where data I want to copy

For Each cell In WBOR.Range("H5", Range("H5").End(xlDown))
    If cell.Value <> "" Then
        WorksheetName = cell.Offset(0, -1).Value
        Set shW = WBOR.Sheets.Add(After:=Sheets(Sheets.count))
           shW.Name = WorksheetName
           Set shMJ = Wmjf.ActiveSheet
           shMJ.Range("A:U").AutoFilter field:=12, Criteria1:="*" & cell.Value    'Filters depending on the cell value
            Set AutoFilterRng = shMJ.AutoFilter.Range.Offset(1, 0).Resize(.Rows.count - 1, 1).SpecialCells(xlCellTypeVisible)
            shMJ.AutoFilter.Range.Offset(1, 0).Resize(shMJ.AutoFilter.Range.count - 1).Copy shW.Range("A1")
          shMJ.AutoFilterMode = False
    End If
Next

Dim AutoFilterRng As Range
Dim WorksheetName As String
Dim CurrentWSName As Worksheet

For Each Cell In Range("H5", Range("H5").End(xlDown))
    If Cell.Value <> "" Then
        WorksheetName = Cell.Offset(0, -1).Value
        Set CurrentWSName = ActiveWorkbook.Sheets(WorksheetName)
        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
        CurrentWSName.Activate
        Range("A1").PasteSpecial
        Workbooks.Open MJFile
        AutoFilterMode = False
        Workbooks.Open WBOR
    End If
Next