waardes wegschrijven als historie

[janineo]

hoi,

Wie kan mij helpen met het volgende:

Ik heb een sheet die ik iedere week refresh. Met het refreshen worden alle oude waarden overschreven. Nu ben ik op zoek naar een macro die de waarden wegschrijft in een sheet en ik de historie kan terugzien van de afgelopen weken

De tabel word in de orginele sheet met een pivottable gemaakt en bevat alleen de namen die week.

Nu is mij vraag of het moglijke is om met een macro de waarde van de personen weg te schrijven in een andere sheet. en wanneer de naam nog niet in de sheet aanwezig is dan deze toe te voegen.

Mischien is het verhaal een beetje verwarrend maar k heb een voorbeeld toegevoegd.

in sheet1 heb ik als voorbeeld een rijtje gemaakt die in sheet2 moeten worden weggeschreven door middel van de button.

Ik hoop dat jullie me kunnen helpen.

Als iets niet duidelijk is hoor ik het wel

Alvast bedankt!
janine

 

[Gert Bouwmeeste]

Kun je je gegevens op Sheet 1 niet anders indelen? Dan kun je het gewoon met een draaitabel blijven doen. Zie bijgaand voorbeeld.

 

[janineo]

nee kan het niet anders indelen omdat ik gebruik maak een webquerie die word gerefresht zodat de oude data verdwijnt
de waardes van sheet1 worden met formules berekend op basis van de webquerie

 

[Wigi]

Voilà Janine.

Sub Button1_Click()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim iKolom As Integer
    Dim r As Range
    Dim lRij As Long
    Dim rLoop As Range
    
    Set ws1 = ThisWorkbook.Sheets(1)
    Set ws2 = ThisWorkbook.Sheets(2)
    
    For Each rLoop In ws1.Range("A3:A" & ws1.Range("A" & Rows.Count).End(xlUp).Row)
    
        Set r = Nothing
        
        On Error Resume Next
        Set r = ws2.Columns(2).Find(rLoop.Value, after:=ws2.Range("B1"), lookat:=xlWhole, LookIn:=xlValues)
        On Error GoTo 0
        
        If Not r Is Nothing Then
        
            lRij = r.Row
            
        Else
        
            ws2.Range("B" & Rows.Count).End(xlUp).Offset(1).Value = rLoop.Value
            lRij = ws2.Range("B" & Rows.Count).End(xlUp).Row
            
        End If
        
        Set r = ws2.Rows(2).Cells.Find(ws1.Range("B1").Value, after:=ws2.Range("A2"), lookat:=xlWhole, LookIn:=xlValues)
        iKolom = r.Column
        
        ws2.Cells(lRij, iKolom).Value = rLoop.Offset(, 1).Value
        
    Next
    
End Sub

Wigi

 

[janineo]

bedankt Wigi!!

dat is wat ik zocht, ik ga volgende week of misgien nog in het weekend gelijk aan de slag om de code te snappen en het in de orginele sheet te bouwen. Als ik er niet uitkom meld ik het wel

Goed weekend allemaal!

grtz janine

 

[janineo]

hoi, ben bezig met inbouwen van de code, maar ben maar beetje aant proberen met wijzigen van een waarde in de code en dan kijken wat er dan gebeurd. zou iemand me in het kort wat uitleg kunnen geven over de code?

Thanks in advance!
janine

 

[snb]

Het kan ook zo.

Sub Button1_Click()
  sq = Sheets("Sheet1").[A3].CurrentRegion
  With Sheets("Sheet2")
    sn = .Columns(2).SpecialCells(xlCellTypeConstants)

    For j = 1 To UBound(sn)
      c0 = c0 & "|" & sn(j, 1)
    Next
    sn = Split([sheet1!B1] & String(UBound(Split(c0, "|")), "|"), "|")
        
    For j = 1 To UBound(sq)
      If InStr(c0 & "|", "|" & sq(j, 1) & "|") = 0 Then
        c0 = c0 & "|" & sq(j, 1)
        sn = Split(Join(sn, "|") + "|", "|")
      End If
      sn(UBound(Split(Left(c0, InStr(c0 & "|", "|" & sq(j, 1) & "|")), "|"))) = sq(j, 2)
    Next
        
    .Cells(2, 2).Resize(UBound(sn) + 1) = Application.WorksheetFunction.Transpose(Split(c0, "|"))
        
    On Error Resume Next
    y = .Rows(2).Find([sheet1!B1]).Column
    If Err.Number > 0 Then y = .Cells(2, Columns.Count).End(xlToLeft).Offset(, 1).Column
        
    .Cells(2, y).Resize(UBound(sn) + 1) = Application.WorksheetFunction.Transpose(sn)
  End With
End Sub

Deze code voegt automatisch nieuwe namen toe aan het 2e werkblad Als het weeknummer niet bestaat wordt dat ook toegevoegd.

De gegevens van het updatewerkblad worden in matrix sq gezet
De namen in het archiefwerkblad worden ingelezen in variabele c0
Er wordt een matrix sn aangemaakt met evenveel 'cellen' als namen in c0
De namen in het update-werkblad (matrix sq, kolom1) worden vergeleken met de namen in variabele c0. In de overeenkomstige cel van matrix sn wordt de waarde uit het updatewerkblad (matrix sq,kolom2) gezet.
Als de naam niet bestaat worden de variabelen c0 en de matrix sn met 1 uitgebreid.
De variabele c0 wordt in de namenkolom van het archiefwerkblad gezet, de matrix sn in de laatste kolm met gegevens.

 

[janineo]

hoi allemaal!

Bedankt voor jullie reacties! Ik heb het voor elkaar gekregen om het in mijn sheet werkend te krijgen

greetz,
Janine