Assign sheet name in closed Workbook

[chiabgigi]

Hello everyone
my problem is this:
with a combobox I select an item which is the name of the sheet in a closed workbook.
I would like the name of the sheet to be performed to be assigned by the selection.
I have tried various solutions but as a result it is always:
"Subscript out of range"
As it does not identify the sheet name.

Dim oDataBook As Workbook

Private Sub CommandButton1_Click()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim wsName As String
Dim lCopyLastRow As Long
Dim lDest LastRow As Long

wsName = Me.Combobox1.Value

Set wsCopy = Workbooks("gigi_test.xlsm").Worksheets("tempData")

If wsName <> "" Then
  Set wsDest = Workbooks(ThisWorkbook.Path & "/" & "orders.xlsm").Worksheets(wsName) ' <= HERE
End If

lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

wsCopy.Range("A2:D" & lCopyLastRow).Copy wsDest.Range("A" & lDestLsstRow)
End Sub

Private Sub UserForm_Initialize()
Dim i As Long
Dim rng As Range

Application.ScreenUpdating = False
Set oDataBook = Workbooks.Open(ThisWorkbook.Path & "/" "orders.xlsm")
With oDataBook.Sheets("Sheet1")
  Set rng = .Range(.Range("A1"). .Range("A" & Rows.Count).End(xlUp))
End With
ComboBox1.Clear
ComboBox1.List = rng.Value
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Terminate()
oDataBook.Close
Set oDataBook = Nothing
End Sub

 

[chiabgigi]

Dim lDestLastRow As Long

 

[mumps]

Try these macros. You don't need the UserForm_Terminate macro. Please note that the code saves the "orders" file before closing it replacing the previous version. I asumed you wanted to save it because you have added data to it.

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim wsCopy As Worksheet, wsDest As Worksheet, oDataBook As Workbook, wsName As String, lCopyLastRow As Long, lDestLastRow As Long
    wsName = Me.ComboBox1.Value
    Set wsCopy = Workbooks("gigi_test.xlsm").Worksheets("tempData")
    If wsName <> "" Then
        Set wsDest = Workbooks("orders.xslm").Sheets(wsName)
    End If
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
    wsCopy.Range("A2:D" & lCopyLastRow).Copy wsDest.Range("A" & lDestLastRow)
    Application.DisplayAlerts = False
    Workbooks("orders.xslm").Close True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
    Dim i As Long, rng As Range, oDataBook As Workbook
    Application.ScreenUpdating = False
    Set oDataBook = Workbooks.Open(ThisWorkbook.Path & "\" & "orders.xlsm")
    With oDataBook.Sheets("Sheet1")
        Set rng = .Range(.Range("A1").Range("A" & Rows.Count).End(xlUp))
    End With
    ComboBox1.Clear
    ComboBox1.List = rng.Value
    Application.ScreenUpdating = True
End Sub

 

[chiabgigi]

thanks mumps, but there are changes and alterations
the files are xlsm
then I changed the code, but thanks to your idea.
The 'Initialize' sub is fine in my version.
The only thing that's not good is that it asks me to save the file, instead of doing it automatically on closing.

Application.DisplayAlerts = False
Workbooks("ordini_forum.xlsm").Save
Workbooks("ordini_forum.xlsm").Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

I also tried with

Application.DisplayAlerts = False
Workbooks("ordini_forum.xlsm").Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

but useless

 

[mumps]

The second code does the same as the first code but is shorter. The second code should save and replace the existing file without asking you to save. Can you could upload copies of your files to a free site such as www.box.com or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. If the workbooks contains confidential information, you could replace it with generic data.

 

[chiabgigi]

sorry mumps, but probably because of the translations, I can't follow you
what do you mean by code first
per second
also because I think I have tried them all but it does not save automatically

the fact remains that you did a great job
there is only to solve the automatic saving

ok i understand your intentions mumps, but i would like that after entering data excel / workbook it closes with automatic save

 

[chiabgigi]

it is not possible to save because the file is read only therefore it is assumed that:
- 'Initialize' opens for reading to retrieve the combobox 'SourceRow'
- allows the Paste of the selection
- It remains in memory that the file is read only, it cannot be saved

 

[mumps]

Ciao. Try doing the following:

Click FILE ... OPEN in Excel to find your file. Right click on the file and then click PROPERTIES. In the GENERAL tab, make sure that the READ ONLY box to the right of ATTRIBUTES is unchecked. Save the file, close it and then re-open it. Does it open in regular mode and not in read only mode? If it opens in regular mode, try the macro again.

 

[chiabgigi]

thanks for the help mumps
I solved it and it works

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim wsName As String
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

wsName = Me.ComboBox1.Value

Application.ScreenUpdating = False

'  'Set variables for copy and destination sheets
  Set wsCopy = Workbooks("gigi_test.xlsm").Worksheets("tempData")
  Set wsDest = Workbooks("orders.xlsm").Worksheets(wsName)
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'  '2. Find first blank row in the destination range based on data in column A
'  'Offset property moves down 1 row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row '
'  '3. Copy & Paste Data
  wsCopy.Range("A1:H" & lCopyLastRow).Copy
  wsDest.Range("A" & lDestLastRow).PasteSpecial Paste:=xlPasteColumnWidths
  wsDest.Range("A" & lDestLastRow).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Application.ScreenUpdating = True

Sheets(1).Select

 

[mumps]

Glad it worked out.