Saya punya masalah dalam mengambil data
kodenya cukup panjang. sebagai contoh file terlampir. adapun kode yang
saya pakai sbb:
Sub AmbilData()
On Error Resume Next
Dim rData As Range, rHasil As Range, wsa As Range, wsb As Range,_
wsc As Range, wsd As Range, wse As Range, wsf As Range, wsg As Range, _
wsh As Range, wsi As Range, wsj As Range, wsk As Range, wss As Range
Dim i As Long, r As Long
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set rData = Sheets("ANGGARAN").Range("B4").CurrentRegion
Set rHasil = Sheets("SPP").Range("B16").CurrentRegion
Set wsa = Sheets("ANGGARAN").Range("K2").Value
Set wsb = Sheets("ANGGARAN").Range("L2").Value
Set wsc = Sheets("ANGGARAN").Range("M2").Value
Set wsd = Sheets("ANGGARAN").Range("N2").Value
Set wse = Sheets("ANGGARAN").Range("O2").Value
Set wsf = Sheets("ANGGARAN").Range("P2").Value
Set wsg = Sheets("ANGGARAN").Range("Q2").Value
Set wsh = Sheets("ANGGARAN").Range("R2").Value
Set wsi = Sheets("ANGGARAN").Range("S2").Value
Set wsj = Sheets("ANGGARAN").Range("T2").Value
Set wsk = Sheets("ANGGARAN").Range("U2").Value
Set wss = Sheets("ANGGARAN").Range("BF2").Value
ThisWorkbook.Sheets("SPP").Activate
rHasil.Offset(1, 0).ClearContents
Sheets("SPP").Range("A16:k100") = ""
Sheets("SPP").Range("A16:k100").HorizontalAlignment = xlLeft
If rData.Range("BN1").Value >= 1 Then
r = 0
For i = 1 To rData.Rows.Count
If rData(i, 68) = 1 Then
r = r + 1
rHasil(r, 1).Value = rData(i, 2).Value
rHasil(r, 4).Value = rData(i, 10).Value
Mulai Tidak Jalan Hasilnya selalu if yang paling bawah yaitu >> (
If wss = wsk Then
rHasil(r, 5).Value = rData(i, 32).Value
rHasil(r, 6).Value = rData(i, 45).Value )>>
End If
Tidak berfungsi
If wss = wsa Then
rHasil(r, 5).Value = rData(i, 22).Value
rHasil(r, 6).Value = rData(i, 35).Value
End If
If wss = wsb Then
rHasil(r, 5).Value = rData(i, 23).Value
rHasil(r, 6).Value = rData(i, 36).Value
End If
If wss = wsc Then
rHasil(r, 5).Value = rData(i, 24).Value
rHasil(r, 6).Value = rData(i, 37).Value
End If
If wss = wsd Then
rHasil(r, 5).Value = rData(i, 25).Value
rHasil(r, 6).Value = rData(i, 38).Value
End If
If wss = wse Then
rHasil(r, 5).Value = rData(i, 26).Value
rHasil(r, 6).Value = rData(i, 39).Value
End If
If wss = wsf.Value Then
rHasil(r, 5).Value = rData(i, 27).Value
rHasil(r, 6).Value = rData(i, 40).Value
End If
If wss = wsg Then
rHasil(r, 5).Value = rData(i, 28).Value
rHasil(r, 6).Value = rData(i, 41).Value
End If
If wss = wsh Then
rHasil(r, 5).Value = rData(i, 29).Value
rHasil(r, 6).Value = rData(i, 42).Value
End If
If wss = wsi Then
rHasil(r, 5).Value = rData(i, 30).Value
rHasil(r, 6).Value = rData(i, 43).Value
End If
Sampai sini dan dan hasilnya selalu yang bawah
If wss = wsj Then
rHasil(r, 5).Value = rData(i, 31).Value
rHasil(r, 6).Value = rData(i, 44).Value
End If
If wss = wsk Then
rHasil(r, 5).Value = rData(i, 32).Value
rHasil(r, 6).Value = rData(i, 45).Value
End If
rHasil(r, 7).Value = c.Offset(0, 2).Value
rHasil(r, 8).FormulaR1C1 = "=RC[-2]+RC[-1]"
rHasil(r, 9).Value = "=RC[-4]-RC[-1]"
End If
Next i
End If
End Sub
Kenapa
memisahkan data.xlsm
Description: application/vnd.ms-excel.sheet.macroenabled.12
