Díky za radu. Dovysvětlím.
Mám dva listy v xls, které se jmenují jinak. U těchto dvou listů chci spouštět stejné makro, které pracuje v každém listě samostatně. Tzn., Spustím makro pro list 1 - tam něco vykoná. Jindy spustím pro list2 stejné makro, které v listě 2 vykoná stejnou činnost jako v listě1. toto makro je spuštěno z třetího listu. Makro pracuje i s jinými listy, takže ho mám napsané způsobem Workbook("").Sheets("").Range("").......
Abych nemusel mít dvě stejné makra, pouze s jinou adresou listu, potřebuji tuto adresu vložit do proměnné ve vyvolávajícím makru. Podle toho, které vyvolávající makro je spuštěno, tak se deklaruje proměnná adresy listu.
Pro lepší názornost zasílám i kód.
1.Vyvolávající makro
Kód: Vybrat vše
Sub vyvolaniEi0()
'Procedura pro vyvolání makra VlozeniDoTermPrehledReal pro oba sešity a to Ei=0
'----------------------------------------------------------------------------------------
Private Const Ei As Variant = "Ei=0" 'zde chyba, potřebuji deklarovat proměnou pro proceduru VlozeniDoTermPrehledReal
Call VlozeniDoTermPrehledReal
End Sub
2.Vyvolávající makro
Kód: Vybrat vše
Sub vyvolaniEi00()
'Procedura pro vyvolání makra VlozeniDoTermPrehledReal pro oba sešity a to Ei=0
'----------------------------------------------------------------------------------------
Private Const Ei As Variant = "Ei>0" 'zde chyba, potřebuji deklarovat proměnou pro proceduru VlozeniDoTermPrehledReal
Call VlozeniDoTermPrehledReal
End Sub
3.Společné makro pro dva listy:
Kód: Vybrat vše
Sub VlozeniDoTermPrehledReal()
'Makro vloží označené řádky do hlavního přehledu TermPrehlůedReal
'Odstarní se záznam z výchozího listu
'Označení (projekt, Ei) vkládaného projektu se vloží do listu DbPartaci sl., E,F,G
'----------------------------------------------------------------------------------------
Sheets("EI>0").Select
Range("A2").Select
rwP = Workbooks("TermPrehled_v1").Sheets(Ei > 0).Cells(Rows.Count, "P").End(xlUp).Row
rwM = Workbooks("TermPrehled_v1").Sheets(Ei > 0).Cells(Rows.Count, "M").End(xlUp).Row
For i = 2 To rwP
Dim Project As Range
Set Project = Sheets("Ei>0").Range("S" & i)
PocetVyskytu = Application.WorksheetFunction.CountIf(Range("M2", "M" & rwM), Project)
If Range("P" & i) = "Ano" Then
'Vložím všechny se vyskytující položky pro daný projekt
For ii = 1 To PocetVyskytu
Sheets("EI>0").Select
Range("A2").Select
Cells.Find(What:=Project, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
clF = ActiveCell.Column
rwF = ActiveCell.Row
Range(Cells(rwF, clF - 1), Cells(rwF, 1)).Copy
Sheets("TermPrehledReal").Select
Range("A1").End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("EI>0").Select
Sheets("Ei>0").Range(Cells(rwF, clF), Cells(rwF, 1)).Delete (xlShiftUp)
Next
End If
'vymažu všechny se vyskytující položky pro daný projekt
If Range("P" & i) = "NE" Then
For ii = 1 To PocetVyskytu
Sheets("EI>0").Select
Range("A2").Select
Cells.Find(What:=Project, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
clF = ActiveCell.Column
rwF = ActiveCell.Row
Sheets("Ei>0").Range(Cells(rwF, clF), Cells(rwF, 1)).Delete (xlShiftUp)
Next
End If
Next
'Odstranění položek ze sledovačky - pouze vložené položky, tzn., s příznakem ANO
For A = 2 To rwP
If Range("P" & A) = "Ano" Then
Sheets("Ei>0").Range("Q" & A, "R" & A).Copy
rwDbE = Sheets("DbPartaci").Cells(Rows.Count, "E").End(xlUp).Row + 1
Sheets("DbPartaci").Select
Range("E" & rwDbE).Select
ActiveSheet.Paste
Sheets("Ei>0").Range("P" & A, "S" & A).Delete (xlShiftUp)
End If
If Range("P" & A) = "Ne" Then
Sheets("Ei>0").Range("Q" & A, "R" & A).Copy
rwDbI = Sheets("DbPartaci").Cells(Rows.Count, "I").End(xlUp).Row + 1
Sheets("DbPartaci").Select
Range("I" & rwDbI).Select
ActiveSheet.Paste
Sheets("Ei>0").Range("P" & A, "S" & A).Delete (xlShiftUp)
End If
Next
End Sub