Moga-moga file terlampir bisa memberi ide. On Wed, Oct 14, 2015 at 10:05 PM, Walsoyo [email protected] [belajar-excel] <[email protected]> wrote:
>
>
> 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
>
>
re-memisahkan data.xlsm
Description: application/vnd.ms-excel.sheet.macroenabled.12
