Přidat do zápisu podmínku Vyřešeno

[junis]

Zdravím, potřeboval bych do níže uvedeného zápisu přidat podmínku, pokud bude v Listu "Inventura" v bunce H2 číslo>1, napíše hlášku a nic nenačte. Díky
Sub ImportListu()

Dim Zdroj As Workbook, Cil As Workbook
Dim ZdrojList As Worksheet

'jméno listu který se bude kopírovat
Const JmenoZdrojListu As String = "V seznamu ANO"

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFilePicker)
'nastavení úvodní složky procházení
.InitialFileName = Environ("Userprofile") & "\Desktop\"
.Title = "Vyber soubor k exportu listu """ & JmenoZdrojListu & """"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel", "*.xls; *.xlsx", 1
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Nebyl vybrán žádný soubor!", vbExclamation, "!!! Varování !!!"
Exit Sub
Else
'načtení jednoslivých souborů a listu do proměnných
Set Zdroj = GetObject(.SelectedItems(1)) 'otevření zdrojového souboru
On Error Resume Next
Err.Clear
Set ZdrojList = Zdroj.Worksheets(JmenoZdrojListu) ' načtení kopírovaného listu do proměnné
If Err.Number <> 0 Then
MsgBox " Zvolený soubor neobsahuje potřebný list s názvem " & vbNewLine & """" & JmenoZdrojListu & """", vbCritical, "!!! CHYBA !!!"
GoTo konec
End If
On Error GoTo 0
Set Cil = ThisWorkbook

'kopírování listu
ZdrojList.Copy After:=Cil.Worksheets(Cil.Worksheets.Count)

'zavření zdrojového souboru bez uložení
Zdroj.Close SaveChanges:=False

End If
End With

konec:
Application.ScreenUpdating = True

Set ZdrojList = Nothing
Set Zdroj = Nothing
Set Cil = Nothing

End Sub

[Reklama]

[Grimm]

Aneb chcete mi pomoct, starejte se.
Schválně počkám, zda Ti to dojde.

[junis]

Tak se omlouvám, už se mi to povedlo. Hlásilo mi to pořád chybu, ale nakonec se zdařilo. Trochu jsem si s tím musel pohrát.
Ten zápis jsi mi psal tuším ty, jseš dobrej. Ale přesto díky.
Jo stačilo doplnit:
If Worksheets("Inventura").Range("D2").Value > 1 Then
MsgBox "Na listu ""Inventura""jsou data." & vbNewLine & "Dříve smažte data z Inventury, poté můžete načíst nový soubor", vbInformation, "Info"
Exit Sub
End If