MS Excel

Ahoj,tak zase potřebuji trochu trknout. Chci vložit do listu data, která jsou kopírována z listu jehož název mi určuje podmínka. Lidově řečeno:
1.označ buňku S5
2.Podmínka:
jestliže hodnota v buňce S5 = 0,02 vyber list ("0,02")/ jestliže hodnota v buňce S5 = 0,01 vyber list ("0,01")/ jestliže hodnota v buňce S5 = 0,025 vyber list ("0,025")/
3. Po vybrání kopírovat data do určeného listu..... ale s tím si už poradím
4.Pokud není ani jedna podmínka splněna:
MsgBox ("Není určena tolerance")
End If
Tak teď jen z "Lidově řečeno" to převést do VBA

Snad jsem to napsal srozumitelně a někdo mi poradí. Díky.

Zaslat odpověď >

Jeza.m(8.3.2010 18:54)#001324

Posílám 3 pokusy :-)

1) kopírování musí být spuštěno z každého case samostatně.
Public Sub pok1()
Select Case Range("S5").Value
Case Is = 0.02
Sheets("0,02").Select
Case Is = 0.01
Sheets("0,01").Select
Case Is = 0.025
Sheets("0,025").Select
Case Else
MsgBox "já ti nevím"
End Select
End Sub
2) U každého case zapiš do proměnné název a na konci vyhodnoť proměnnou a proveď další akce:
Public Sub pok2()
Dim listn As String
Select Case Range("S5").Value
Case Is = 0.02
listn = "0,02"
Case Is = 0.01
listn = "0,01"
Case Is = 0.025
listn = "0,025"
End Select

If listn <> "" Then
Sheets(listn).Select
'kopíruj
Else
MsgBox "já ti nevím"
End If
End Sub

3) ověř všechny hodnoty v jednom kroku a otevři list na základě hodnoty (je-li hodnota v seznamu), jinak msgbox:
Public Sub pok3()
Dim listn As String
Select Case Range("S5").Value
Case Is = 0.02, 0.01, 0.025
listn = Range("S5").Value
Sheets(listn).Select
Case Else
MsgBox "já ti nevím"
End Select
End Sub

M@citovat

radekb(9.3.2010 7:59)#001326

Ahoj,
díky za návody.Já jsem se pokoušel i sám a nakonec mi fugovalo tohle:
Range("S5").Select
If (Range("S5") = 0.01) = True Then
Sheets("0,01").Select
ActiveWindow.SmallScroll Down:=-111
Range("D13:P124").Select
Selection.Copy
Sheets("Radiální házivost").Select
Range("D13").Select
ActiveSheet.Paste

ElseIf (Range("S5") = 0.02) = True Then
Sheets("0,02").Select
ActiveWindow.SmallScroll Down:=-111
Range("D13:P124").Select
Selection.Copy
Sheets("Radiální házivost").Select
Range("D13").Select
ActiveSheet.Paste

ElseIf (Range("S5") = 0.025) = True Then
Sheets("0,025").Select
ActiveWindow.SmallScroll Down:=-111
Range("D13:P124").Select
Selection.Copy
Sheets("Radiální házivost").Select
Range("D13").Select
ActiveSheet.Paste

Else
MsgBox ("Není určena tolerance")
End If
End Sub
Ale vyzkouším i tvoje možnosti.
No a ještě jedna OTÁZKA
Lze kopírovat data i ze skrytých listů? Mě to po skrytí listů zahlásilo chybu.citovat

Jeza.m(9.3.2010 19:43)#001331

Ahoj,

možností je spousta :-).

Jinak jo, kopírovaz ze skrytých i velmi skrytých listů lze, jen nemůžeš použít příkazy select ani selection, ale provést přímo
Sheets("123").Range("D13:P124").Copy

M@citovat

Téma: Podmíněné kopírování

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje