Berekende waarde in bestand kopieren naar cel in ander bestand

[Steven J.]

Gisteren een vraag (http://www.helpmij.nl/forum/showthread.php?t=424263) gesteld en erg goed meegeholpen door twee leden maar nu wil ik nog een stapje verder.

Dit is de code die ik uiteindelijk in mijn Persoonlijke map heb geplaatst zodat ik bij elke binnengekomen telling de macro tot mijn beschikking heb. Dit werkt goed.

Sub Telling_verwerken()

Dim ws1 As Worksheet
Dim strFileExtStr As String
Dim lngFileFormatNum As Long
Dim curWaardeverschil As Currency
Dim strVoorraadpunt As String

'Bepaal op basis van gedeelte van cel C5 het voorraadpunt
strVoorraadpunt = Mid([C5], 2)
'Bepaal op basis van de cellen in kolom H8 en lager het totale waardeverschil
curWaardeverschil = WorksheetFunction.Sum(Range("H8:H" & Range("H" & Rows.Count).End(xlUp).Row))
'Zet het waardeverschil in de twee lege cel onder kolom die geteld is
Sheets(1).Cells(Rows.Count, 8).End(xlUp).Offset(2) = curWaardeverschil


'Bepaal de Excel versie en file extension/format
If Val(Application.Version) < 12 Then
'Excel 97-2003
strFileExtStr = ".xls": lngFileFormatNum = -4143
Else
'Excel 2007
If ws1.Parent.FileFormat = 56 Then
    strFileExtStr = ".xls": lngFileFormatNum = 56
Else
    strFileExtStr = ".xlsx": lngFileFormatNum = 51
End If
End If

  
'Bewaar document op plek ... onder gedefinieerde naam
  ThisWorkbook.SaveAs "C:\TELLING\" & strVoorraadpunt & "_" & Format(Mid([F1], 2), "yyyy-mm-dd") & strFileExtStr, lngFileFormatNum

End Sub

Tijdens de bovenstaande code is de variabele "curWaardeverschil" en de variabele "strVoorraadpunt" berekent. Deze variabel curWaardeverschil wil ik nu plakken in een ander document. Dit document bestaat uit drie tabbladen. Op het laatste tabblad staat een tabel die loopt van A5 tot en met K650. In kolom C staan de voorraadpunten en in kolom K moet het waardeverschil geplakt worden.

Ik heb al aardig lopen stoeien en zoeken op allerlei sites (Google is my friend) maar het lukt niet. Wie kan mij helpen?

 

[snb]

Sub Telling_verwerken()
  With Sheets(1)
    c0 = Mid(.[C5], 2)
    With .Cells(Rows.Count, 8).End(xlUp).
      c1 = WorksheetFunction.Sum(sheets(1).Range("H8:H" & .Row)
      .Offset(2) = c1
    End with
    ThisWorkbook.SaveAs "C:\TELLING\" & c0 & "_" & Format(Mid(.[F1], 2), "yyyy-mm-dd") & ".xls"
  End with

  with workbooks.add
     with .sheets(1).cells(rows.count,3).end(xlup)
      .offset(1)=c0
      .offset(1,9)=c1
     end with
  end with
End Sub

 

[Steven J.]

Hoi snb, helaas doet deze code niet wat ik nodig heb / bedoelde. Zoiets had ik zelf ook al alleen mijn probleem zit m vooral in het laten zoeken in een ander document naar een bepaalde waarde.

  with workbooks.add
     with .sheets(1).cells(rows.count,3).end(xlup)
      .offset(1)=c0
      .offset(1,9)=c1
     end with
  end with

Met deze code wordt er een nieuwe map gemaakt maar ik wil juist dat de waarde (curWaardeverschil) gekopieerd wordt naar een bestaande map (Rapport_telling.xls) die al gevuld is met data. Dus in het reeds bestaande document moet er worden gezocht op tabblad Data in kolom C naar de waarde strVoorraadpunt en in diezelfde rij moet dan in kolom K de waarde curWaardeverschil worden geplakt.

 

[snb]

Deze variabel curWaardeverschil wil ik nu plakken in een ander document.

Kun je proberen je vraag consistent te formuleren ?

 

[Steven J.]

Consistent? Volgens mij deed ik dat al of ik moet mij vergissen. In dat laatste geval sorry. Ik dacht niets tegenstrijdigs te hebben gevraagd. Alleen heb ik ter verduidelijking in mijn laatste bericht aangegeven hoe dit andere document heet omdat ik gezien je reactie denk dat de vraag niet voldoende duidelijk was overgekomen.

Terugkomend op de vraag is het dus de bedoeling dat de waarde gekopieerd wordt naar een reeds bestaand document. Ik hoop dat jij (of iemand anders) alsnog naar de vraag wilt kijken en mij op weg wilt helpen. :thumb:

 

[Steven J.]

Na een avond flink zoeken en proberen ben ik er zelf uitgekomen. De totale code die ik nu gebruik heb ik hieronder geplakt. Ik heb deze in mijn persoonlijke map staan zodat ik die altijd kan gebruiken.

Option Explicit

Sub Telling_verwerken()

Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim strFileExtStr As String
Dim lngFileFormatNum As Long
Dim curWaardeverschil As Currency
Dim strVoorraadpunt As String

'Bepaal op basis van gedeelte van cel C5 het voorraadpunt
strVoorraadpunt = Mid([C5], 2)
'Bepaal op basis van de cellen in kolom H8 en lager het totale waardeverschil
curWaardeverschil = WorksheetFunction.Sum(Range("H8:H" & Range("H" & Rows.Count).End(xlUp).Row))
'Zet het waardeverschil in de twee lege cel onder kolom die geteld is
Sheets(1).Cells(Rows.Count, 8).End(xlUp).Offset(2) = curWaardeverschil


'Bepaal de Excel versie en file extension/format
If Val(Application.Version) < 12 Then
'Excel 97-2003
strFileExtStr = ".xls": lngFileFormatNum = -4143
Else
'Excel 2007
If ws1.Parent.FileFormat = 56 Then
    strFileExtStr = ".xls": lngFileFormatNum = 56
Else
    strFileExtStr = ".xlsx": lngFileFormatNum = 51
End If
End If



'Bepaal de optelsom van de waarden in kolom H en zet deze eronder neer
'  With Sheets(1).Cells(Rows.Count, 8).End(xlUp)
'    .Offset(2).Formula = "=SUM(H8:H" & .Row & ")"
'  End With
  
'Bewaar actieve document op plek ... onder gedefinieerde naam
ActiveWorkbook.SaveAs "[I]pad er naar toe[/I]" & strVoorraadpunt & "_" & Format(Mid([F1], 2), "yyyy-mm-dd") & strFileExtStr, lngFileFormatNum

'Open bestaand document als deze nog niet geopend is.
On Error Resume Next
    Set wb1 = Workbooks("[I]bestandsnaam[/I]")
    On Error GoTo 0
    If wb1 Is Nothing Then
        Set wb1 = Workbooks.Open("[I]bestandsnaam + pad er naar toe[/I]")
    Else
        wb1.Activate
    End If

'Activeer tabblad "Data" van het geopende en geactiveerde document
wb1.Worksheets("Data").Activate
'Selecteer de cel waarin het huidige voorraadpunt staat
Cells.Find(what:=strVoorraadpunt).Activate
ActiveCell.Offset(rowOffset:=0, columnOffset:=7).Activate
ActiveCell = curWaardeverschil
Selection.Style = "Currency"

End Sub