MS Excel

Zdravim,

Potreboval bych pomoc s makrem, ktere ma za ukol:

Zkopirovat hodnoty z sheetu A z radku X do sheetu X na radek s datem, ktere se rovna datu v sheetu A v bunce A1 ( napr tedy hodnoty 1,2,3,4,5,6 z sheetu A zkopirovat do bunek B5:G5 v sheetu x) a nasledne udelat totez s radkem Y (do sheetu Y) a s radkem Z (do sheetu Z).

Kdyz v bunce A1 zmenim datum na rekneme 24.2.2016, tak chci, aby se hodnoty kopirovaly do oblasti B4:G4, kdyz na 26.2.2016, tak do oblasti B6:G6 atd. Kopirovat se tedy budou vzdy 3 radky do prislusnych sheetu a oblasti, pricemz kazdy den bude pribyvat do sheetu X,Y a Z jedno nove datum.

Pouzivam Office 365 (2013) 64 bit verzi.

Predem diky moc za pomoc.

Pepe

Zaslat odpověď >

elninoslov(25.2.2016 17:48)#030383

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RZdroj As Long, RCiel As Long, D As Date, Nazvy, i As Integer
If Not Intersect(Target, Cells(1, 1)) Is Nothing Then
D = Cells(1, 1): Nazvy = Array("X", "Y", "Z")
On Error Resume Next
For i = LBound(Nazvy) To UBound(Nazvy)
With Worksheets(Nazvy(i))
RZdroj = WorksheetFunction.Match(Nazvy(i), Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row), 0)
RCiel = WorksheetFunction.Match(CLng(D), .Cells(1, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row).Value2, 0)
If Err = 0 Then .Cells(RCiel, 2).Resize(1, 6).Value = Cells(RZdroj, 2).Resize(1, 6).Value Else Err.Clear
End With
Next i
End If
End Subcitovat

elninoslov(28.2.2016 16:42)#030448

Datum1.xlsm - iba zmeníte hodnotu dátumu v A1 na liste A, a samé to skopíruje hodnoty na dané miesta.
Datum2.xlsm - hodnoty na dané miesta to skopíruje až po stlačení tlačidla.

Příloha: zip