vba code werkt niet

[tom86c]

Beste,

Ik probeer een code te schrijven om de waarde van cellen <>0 van bereik i25:I319 blad1 te kopiëren naar een kolom op Sheet 1 op dezelfde rijhoogte.

Sheets("Sheet1").Select

     Dim rng As Range, i As Integer
Set rng = Range("I25:I319")
For i = rng.Cells.Count To 1 Step -1
If rng.Cells(i).Value <> 0 Then Sheets("Blad1").Range("I" & i).Copy
Sheets("Sheet1").Range("J" & i).PasteSpecial xlValues

Next i

Kan iemand mij hier bij helpen?

Alvast bedankt.

 

[edmoor]

Je kan beter je bestand plaatsen in plaats van gedeeltelijke code.

 

[HSV]

sheet1, Blad1 brengt me misschien in verwarring.

Sub hsv()
 Sheets("sheet1").Range("j25:j319") = [if(blad1!i25:i319<>0,blad1!i25:i319,"")]
End Sub

 

[tom86c]

voorwaarden

In sheet 1 mogen enkel waarden ingevuld worden geen formules en geen nullen

 

[tom86c]

exel bestand

Bekijk bijlage 17A02_Template_E_Meetstaat 181205 test2.xls

 

[HSV]

Hoe ga je 307 rijen aan gegevens van blad1 stoppen in 296 rijen in sheet1 ?

Blad1 = I18:I324 = 307 rijen.
Sheet1 = J24:J319 = 296 rijen.

 

[tom86c]

rijen

Rij 24 tem 31 blad 1 bij elkaar op tellen en waarde kopiëren naar rij 30 sheet 1
Rij 32 tem 36 blad 1 bij elkaar op tellen en waarde koperen naar rij 31 sheet 1

 

[VenA]

Ik zou SOM.ALS() of SOMMEN.ALS() gebruiken. Een voorbeeldbestand plaatsen wat de kern van het probleem weergeeft is voor jezelf en de helpers duidelijker.

 

[emields]

Waarom staan de nr's in nr post op blad1 als tekst?

 

[HSV]

Sub hsv()
Dim sv, hs, i As Long, j As Long, y As Long, nieuw As String
sv = Sheets("blad1").Range("a19:i324")
hs = Sheets("sheet1").Range("a25:j319")
  With CreateObject("scripting.dictionary")
     For i = 1 To UBound(sv)
       For j = 1 To Len(sv(i, 4))
         If IsNumeric(Mid(sv(i, 4), j, 1)) Then nieuw = nieuw & Mid(sv(i, 4), j, 1)
       Next j
          If nieuw <> "" Then
            sv(i, 4) = nieuw
            nieuw = ""
            .Item(sv(i, 4)) = .Item(sv(i, 4)) + sv(i, 9)
          End If
     Next i
    For i = 1 To UBound(hs)
     If hs(i, 2) <> "" Then
       hs(i, 10) = IIf(.Item(.keys()(y)) = 0, "", .Item(.keys()(y)))
       y = y + 1
      End If
     Next
  End With
Sheets("sheet1").Range("a25:j319") = hs
End Sub

Of een lusje minder.

Sub hsv_2()
Dim sv, hs, i As Long, RegEx As Object
sv = Sheets("blad1").Range("a19:i324")
hs = Sheets("sheet1").Range("a25:j319")
With CreateObject("scripting.dictionary")
Set RegEx = CreateObject("VBScript.RegExp")
   For i = 1 To UBound(sv)
    If sv(i, 3) = "" Then
        RegEx.Pattern = "[A-Za-z]"
        RegEx.Global = True
        sv(i, 4) = RegEx.Replace(sv(i, 4), "")
    .Item(sv(i, 4)) = .Item(sv(i, 4)) + sv(i, 9)
  End If
 Next i
 For i = 1 To UBound(hs)
     If hs(i, 2) <> "" Then
       hs(i, 10) = IIf(.Item(.keys()(y)) = 0, "", .Item(.keys()(y)))
       y = y + 1
      End If
     Next
End With
Sheets("sheet1").Range("a25:j319") = hs
End Sub