Use a Cell Value as a Worksheet Name - excel

Question

I want to paste data from a Workbook to another workbook into a sheet which has the name of a cell value. I don't know if that's possible, but I'm struggling with that and I can't find anything similar on internet.
This is my code so far:
'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
After other code which is not important, I made this:
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
Thank you very much in advance
If you want to see the whole code:
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
This is the error I get and debug shows the next line:

Answer 1

This is an untested code. I do not have the necessary data to test it. It must give you some hints in order to understand what is to be done:
Please add Option Explicit on top of your module. This will oblige you to declare all variables...
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

Answer 2

This is not the answer BUT may help you:
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

Answer 3

I should not use .paste instead it should be .PasteSpecial and set the Worksheet. In this case WorksheetName = Cell.Offset(0,-1).Value and then set the Worksheet with that name so it will be Dim CurrentWSName, Set CurrentWSName = ActiveWorkbook.Sheets(WorksheetName) Code will be like this:
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