We have this oldschool software which opens new Excel workbook and fills it with data. It does not do anything more. The workbook stays unsaved and opened.
Now I have created a macro which looks for this newly opened workbook by name (using Workbooks.Count
and Application.Workbooks(i).Name
) and when it finds it, it copies some data from that.
Unfortunately since upgrading to Office 365, the Excel does not see the unsaved workbook so the macro stopped working. The unsaved workbook is not even counted in Workbooks.Count
.
Is there any way for me to make this work again in newest version of Excel?
EDIT: Unfortunately I cannot edit the code of the oldschool program. What bothers me, that when I was using 2013 excel, it worked flawlessly.
Sub zkopirujPoctyZeSesitu()
rozdilPoctuZbozi = 0
rozdilUZbozi = 0
Dim aktualne As Integer
Dim bylo As Integer
Dim franta As String
idSesit = -1
Dim hledas As String
'nalezeni ID Sešitu z NAV
For i = 1 To Workbooks.Count
If InStr(Application.Workbooks(i).Name, "Sešit") > 0 Then
idSesit = i
ElseIf InStr(Application.Workbooks(i).Name, "GENERATOR") > 0 Then
idGenerator = i
End If
Next i
'kontrola zda je otevřenej stav skladu
If idSesit = -1 Then
MsgBox ("Nelze načíst stav skladu z NAV!!!!")
End
ElseIf Not (Workbooks(idSesit).Worksheets(1).Cells(1, 1).Text = "Číslo zboží" And Workbooks(idSesit).Worksheets(1).Cells(1, 2).Text = "Varianta zboží") Then
MsgBox ("Je třeba zavřít všechny Excel soubory s názvem" & Chr(34) & "Sešit" & Chr(34) & vbNewLine & "(kromě výstupního DatSkladu z NAV)")
End
End If
For i = 1 To List1.Cells(Rows.Count, 1).End(xlUp).Row
If Len(List1.Cells(i, 1).Text) = 5 And Left$(List1.Cells(i, 1).Text, 1) = "0" Then
hledas = Right(List1.Cells(i, 1).Text, Len(List1.Cells(i, 1).Text) - 1)
Else
hledas = List1.Cells(i, 1).Value
End If
Set FoundCell = Workbooks(idSesit).Worksheets(1).Range("A:A").Find(What:=hledas, After:=Workbooks(idSesit).Worksheets(1).Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not FoundCell Is Nothing Then
'ochrana proti Mertens lagerSchuette
If (Workbooks(idSesit).Worksheets(1).Cells(FoundCell.Row, 6).Value < 0) Then
MsgBox ("Stav skladu je z Mertensu!!!!")
End
End If
'o kolik se lisi stav
aktualne = Workbooks(idSesit).Worksheets(1).Cells(FoundCell.Row, 6).Value
bylo = List1.Cells(i, 20).Value
rozdilPoctuZbozi = rozdilPoctuZbozi + aktualne - bylo
'pocet zbozi u kteryho je rozdilny stav
If aktualne <> bylo Then
rozdilUZbozi = rozdilUZbozi + 1
End If
'prepis poctu ks
List1.Cells(i, 20).Value = Workbooks(idSesit).Worksheets(1).Cells(FoundCell.Row, 6).Value
End If
Next i
End Sub