Zdravím, chtěl bych Vás požádat o radu.
Jedná sa iba o 3 bunky E1, K1, Q1 (hodnota v zlúčených bunkách E1:E2 sa uchováva v E1), alebo aj inde môžu byť písmená?
Ak kopírujte Data!O2:O4 (to sú 3 riadky) do zelených polí. Tieto polia ale nie sú v stĺpci "i", ktorý nájdete hľadaním písmena.
Skúste tam ešte doplniť nejaké dáta do prílohy (lebo kontrolujete počet v oblasti zelená+1 stĺpec), a pridajte kópiu listu s požadovaným výsledkom, ak teda stlačím "Data B".
Jedná sa o totálnu prkotinu, len Vás tak pochopiť...
V žiadnom prípade nepoužívajte Copy, ale rovno Value2, a rovnako nie 3 takmer rovnaké makrá, ale jedno parametrizované. Všetko spravím ak pochopím...
EDIT:
Skúsil som sa vysomáriť z "popis vs makro". Viď príklad v prílohe.
Sub Data_X(Co As String)
Dim i As Integer
Dim rngZapis As Range
With wsObsluha
On Error Resume Next
i = WorksheetFunction.Match(Co, Array(.Range("E1"), .Range("K1"), .Range("Q1")), 0) - 1
If Err.Number <> 0 Then MsgBox Co & " neexistuje", vbCritical: Exit Sub
On Error GoTo 0
Set rngZapis = .Range("D16:D18").Offset(, i * 6)
End With
If WorksheetFunction.CountA(rngZapis) > 0 Then
If MsgBox("Pod " & Co & " se nalézají data." & vbNewLine & "Chcete je přepsat ?", vbCritical + vbYesNo) = vbNo Then Exit Sub
End If
rngZapis.Value2 = wsData.Range("O2:O4").Value2
End Sub
Sub data_A()
Data_X "A"
End Sub
Sub data_B()
Data_X "B"
End Sub
Sub data_C()
Data_X "C"
End Sub
Ak kopírujte Data!O2:O4 (to sú 3 riadky) do zelených polí. Tieto polia ale nie sú v stĺpci "i", ktorý nájdete hľadaním písmena.
Skúste tam ešte doplniť nejaké dáta do prílohy (lebo kontrolujete počet v oblasti zelená+1 stĺpec), a pridajte kópiu listu s požadovaným výsledkom, ak teda stlačím "Data B".
Jedná sa o totálnu prkotinu, len Vás tak pochopiť...
V žiadnom prípade nepoužívajte Copy, ale rovno Value2, a rovnako nie 3 takmer rovnaké makrá, ale jedno parametrizované. Všetko spravím ak pochopím...
EDIT:
Skúsil som sa vysomáriť z "popis vs makro". Viď príklad v prílohe.
Sub Data_X(Co As String)
Dim i As Integer
Dim rngZapis As Range
With wsObsluha
On Error Resume Next
i = WorksheetFunction.Match(Co, Array(.Range("E1"), .Range("K1"), .Range("Q1")), 0) - 1
If Err.Number <> 0 Then MsgBox Co & " neexistuje", vbCritical: Exit Sub
On Error GoTo 0
Set rngZapis = .Range("D16:D18").Offset(, i * 6)
End With
If WorksheetFunction.CountA(rngZapis) > 0 Then
If MsgBox("Pod " & Co & " se nalézají data." & vbNewLine & "Chcete je přepsat ?", vbCritical + vbYesNo) = vbNo Then Exit Sub
End If
rngZapis.Value2 = wsData.Range("O2:O4").Value2
End Sub
Sub data_A()
Data_X "A"
End Sub
Sub data_B()
Data_X "B"
End Sub
Sub data_C()
Data_X "C"
End Sub
Příloha: 
57386_wall_test.zip (23kB, staženo 1x)
citovat57386_wall_test.zip (23kB, staženo 1x)
\n
RSS nejnovější články