Macro tambah week di excel

  1. tahun lalu

    Dear suhu
    Mohon bantuaannya karena saya baru belajar macro di excel.
    Saya membuat tombol macro dengan metode record macro .
    Ada 2 tombol Insert Next (Macro1) dan Start (Macro2) .
    Untuk Tombol Insert Next, jika di run maka akan mencopy nilai dan menambah week baru di setiap sheet dari nilai WTD Plan , WTD Actual dan Normalisasi .
    Sedangkan untuk tombol Start maka akan mengcopy nilai WTD Plan , WTD Actual dan Normalisasi ke coloum week terakhir.

    Namun saya ada kendala jika saya running untuk ke 2 kali maka datanya akan kosong.
    Mohon advicenya...

  2. Terlampir filenya

  3. Mungkin Seperti Ini

  4. Versi Lebih Ringkas Kodenya

  5. Mas @Herry Luas biasa. Sangat membantu, terima kasih banyak . Namun jika saya ingin memasukkan copy nilai target 85% sekalian bagaimana ya?
    Dan jika ingin menambahkan 1 tombol lagi untuk mengcopy nilai WTD Plan, WTD Actual & Normalisasi di coloum atau week terakhir di setiap sheet , dari data yang ada bagaimana ya?

  6. Untuk Memasukan nilai target 85% Tinggal di tambah Kode
    .Cells(6, Columndata) = 85 / 100

    Seharusnya nilai WTD Plan, WTD Actual & Normalisasi di Column yang baru Sudah Otomatis Diisi Dengan Data Yang Baru Sesuai dengan sumber Di K7:K10
    Dengan Kode ini
    'memindah data dari WTD Plan Ke Plan
    .Cells(3, Columndata) = .Cells(7, Columndata + 1)
    'memindah data dari WTD Actual Ke Actual
    .Cells(4, Columndata) = .Cells(8, Columndata + 1)
    'memindah data dari Normalisasi Ke PA Normalisasi
    .Cells(5, Columndata) = .Cells(9, Columndata + 1)

  7. Mas @Herry Terima kasih , namun maksud saya tombol baru ini tidak perlu menambahkan colomb atau week baru. Cuma mencopy data dari WTD Plan, WTD Actual & Normalisasi di week yang terakhir muncul.

  8. Mungkin Seperti Ini

  9. Luar biasa Mas @Herry . Terima kasih banyak atas bantuannya..

  10. sama sama

  11. Mas Herry
    Saya coba memasukkan rumus macro di file lain , namun ada error di

    .Cells(4, Columndata) = "Week" & Format(Right(.Cells(2, Columndata - 1), 2) + 1, "00")

    Berikut rumus yang sudah saya ubah dan contoh gambar file

    Sub ProsesX()

    Dim Nama(1 To 8) As String
    Dim item As Variant
    'Memasukan Nama Sheets Ke Array
    Nama(1) = "390DL Weekly"
    Nama(2) = "777D 3PR Weekly"
    Nama(3) = "777D AGC Weekly"
    Nama(4) = "777D AGC Weekly"
    Nama(5) = "777E Weekly"
    Nama(6) = "777D Process Weekly"
    Nama(7) = "785C Weekly"
    Nama(8) = "CAT340SSA"

    For item = 1 To 8
    With Sheets(Nama(item))
    'Mencari Posisi Akhir Column
    Columndata = .Cells(2, Columns.Count).End(xlToLeft).Column
    'menginsert Column
    .Columns(Columndata).EntireColumn.Insert
    'menambahkan judul weeknya
    .Cells(4, Columndata) = "Week" & Format(Right(.Cells(2, Columndata - 1), 2) + 1, "00")
    'memindah data dari WTD Plan Ke Plan
    .Cells(5, Columndata) = .Cells(7, Columndata + 1)
    'memindah data dari WTD Actual Ke Actual
    .Cells(6, Columndata) = .Cells(8, Columndata + 1)
    'memindah data dari Normalisasi Ke PA Normalisasi
    .Cells(7, Columndata) = .Cells(9, Columndata + 1)
    'Mengisi Target Dengan Angka 85%
    .Cells(8, Columndata) = 85 / 100
    End With
    Next item

    End Sub

    Sub ProsesCopy()

    Dim Nama(1 To 8) As String
    Dim item As Variant
    'Memasukan Nama Sheets Ke Array
    Nama(1) = "390DL Weekly"
    Nama(2) = "777D 3PR Weekly"
    Nama(3) = "777D AGC Weekly"
    Nama(4) = "777D AGC Weekly"
    Nama(5) = "777E Weekly"
    Nama(6) = "777D Process Weekly"
    Nama(7) = "785C Weekly"
    Nama(8) = "CAT340SSA"

    For item = 1 To 8
    With Sheets(Nama(item))
    'Mencari Posisi Akhir Column
    Columndata = .Cells(4, Columns.Count).End(xlToLeft).Column
    'memindah data dari WTD Plan Ke Plan
    .Cells(5, Columndata - 1) = .Cells(7, Columndata)
    'memindah data dari WTD Actual Ke Actual
    .Cells(6, Columndata - 1) = .Cells(8, Columndata)
    'memindah data dari Normalisasi Ke PA Normalisasi
    .Cells(7, Columndata - 1) = .Cells(9, Columndata)
    'Mengisi Target Dengan Angka 85%
    .Cells(8, Columndata - 1) = 85 / 100
    End With
    Next item

    End Sub

    End Sub

  12. Untuk Kode Columndata Perlu Di Ganti Karena Ada Tambahan 2 Kolom MTD YTD
    Hasil Kolom terakhir Diposisi YTD target Kolom diposisi WTD Jadi dikurangi 2

    Mencari Posisi Akhir Column (Angka 2 Diganti 4 dan hasilnya dikurangi 2)
    Columndata = .Cells(4, Columns.Count).End(xlToLeft).Column - 2

  13. Sub ProsesX()

    Dim Nama(1 To 8) As String
    Dim item As Variant
    'Memasukan Nama Sheets Ke Array
    Nama(1) = "390DL Weekly"
    Nama(2) = "777D 3PR Weekly"
    Nama(3) = "777D AGC Weekly"
    Nama(4) = "777D AGC Weekly"
    Nama(5) = "777E Weekly"
    Nama(6) = "777D Process Weekly"
    Nama(7) = "785C Weekly"
    Nama(8) = "CAT340SSA"

    For item = 1 To 8
    With Sheets(Nama(item))
    Mencari Posisi Akhir Column (Angka 2 Diganti 4 dan hasilnya dikurangi 2)
    Columndata = .Cells(4, Columns.Count).End(xlToLeft).Column - 2
    menginsert Column
    .Columns(Columndata).EntireColumn.Insert
    'menambahkan judul weeknya
    .Cells(4, Columndata) = "Week" & Format(Right(.Cells(2, Columndata - 1), 2) + 1, "00")
    memindah data dari WTD Plan Ke Plan (Baris 7 Di Ubah Menjadi 9 )
    .Cells(5, Columndata) = .Cells(9, Columndata + 1)
    memindah data dari WTD Actual Ke Actual (Baris 8 Diubah Menjadi 10)
    .Cells(6, Columndata) = .Cells(10, Columndata + 1)
    memindah data dari Normalisasi Ke PA Normalisasi (Baris 9 Diubah Menjadi 11)
    .Cells(7, Columndata) = .Cells(11, Columndata + 1)
    'Mengisi Target Dengan Angka 85%
    .Cells(8, Columndata) = 85 / 100
    End With
    Next item

    End Sub

    Sub ProsesCopy()

    Dim Nama(1 To 8) As String
    Dim item As Variant
    'Memasukan Nama Sheets Ke Array
    Nama(1) = "390DL Weekly"
    Nama(2) = "777D 3PR Weekly"
    Nama(3) = "777D AGC Weekly"
    Nama(4) = "777D AGC Weekly"
    Nama(5) = "777E Weekly"
    Nama(6) = "777D Process Weekly"
    Nama(7) = "785C Weekly"
    Nama(8) = "CAT340SSA"

    For item = 1 To 8
    With Sheets(Nama(item))
    'Mencari Posisi Akhir Column
    Columndata = .Cells(4, Columns.Count).End(xlToLeft).Column - 2
    'memindah data dari WTD Plan Ke Plan
    .Cells(5, Columndata - 1) = .Cells(9, Columndata)
    'memindah data dari WTD Actual Ke Actual
    .Cells(6, Columndata - 1) = .Cells(10, Columndata)
    'memindah data dari Normalisasi Ke PA Normalisasi
    .Cells(7, Columndata - 1) = .Cells(11, Columndata)
    'Mengisi Target Dengan Angka 85%
    .Cells(8, Columndata - 1) = 85 / 100
    End With
    Next item

    End Sub

  14. Terima kasih Mas @Herry tapi saya coba kenapa masih ada yang error ya?

  15. Karena Nama Sheets harus sama (termasuk Spasinya)
    Nama(1) = "390DL Weekly "
    Nama(2) = "777D 3PR Weekly "
    Nama(3) = "777D AGC Weekly "
    Nama(4) = "777D FKR Weekly "
    Nama(5) = "777E Weekly"
    Nama(6) = "777D Process Weekly"
    Nama(7) = "785C Weekly"
    Nama(8) = "CAT340SSA"

    Untuk Kode Ini ada Kelupaan Ganti dari 2 menjadi 4
    .Cells(4, Columndata) = "Week "&Format(Right(.Cells(4, Columndata - 1), 2) + 1,"00")

    Karena Sheet 390DL Weekly Urutan Barisnya Beda dengan yang lainnya maka Ditambah Kode
    If Item = 1 Then
    A= 1
    Else
    A=0
    End IF
    'memindah data dari WTD Plan Ke Plan
    .Cells(5, Columndata) = .Cells(9 + A, Columndata + 1)
    'memindah data dari WTD Actual Ke Actual
    .Cells(6, Columndata) = .Cells(10+ A, Columndata + 1)
    'memindah data dari Normalisasi Ke PA Normalisasi
    .Cells(7, Columndata) = .Cells(11+A, Columndata + 1)
    'Mengisi Target Dengan Angka 85%
    .Cells(8 + A, Columndata) = 85 / 100

    Selengkapnya menjadi :

    Sub ProsesX()

    Dim Nama(1 To 8) As String
    Dim item As Variant
    'Memasukan Nama Sheets Ke Array
    Nama(1) = "390DL Weekly "
    Nama(2) = "777D 3PR Weekly "
    Nama(3) = "777D AGC Weekly "
    Nama(4) = "777D FKR Weekly "
    Nama(5) = "777E Weekly"
    Nama(6) = "777D Process Weekly"
    Nama(7) = "785C Weekly"
    Nama(8) = "CAT340SSA"

    For item = 1 To 8
    With Sheets(Nama(item))
    'Mencari Posisi Akhir Column
    Columndata = .Cells(4, Columns.Count).End(xlToLeft).Column - 2
    'menginsert Column
    .Columns(Columndata).EntireColumn.Insert
    'menambahkan judul weeknya
    .Cells(4, Columndata) = "Week " & Format(Right(.Cells(4, Columndata - 1), 2) + 1, "00")
    If Item = 1 Then
    A= 1
    Else
    A=0
    End IF
    'memindah data dari WTD Plan Ke Plan
    .Cells(5, Columndata) = .Cells(9 + A, Columndata + 1)
    'memindah data dari WTD Actual Ke Actual
    .Cells(6, Columndata) = .Cells(10+ A, Columndata + 1)
    'memindah data dari Normalisasi Ke PA Normalisasi
    .Cells(7, Columndata) = .Cells(11+A, Columndata + 1)
    'Mengisi Target Dengan Angka 85%
    .Cells(8 + A, Columndata) = 85 / 100
    End With
    Next item

    End Sub

    Sub ProsesCopy()

    Dim Nama(1 To 8) As String
    Dim item As Variant
    'Memasukan Nama Sheets Ke Array
    Nama(1) = "390DL Weekly "
    Nama(2) = "777D 3PR Weekly "
    Nama(3) = "777D AGC Weekly "
    Nama(4) = "777D FKR Weekly "
    Nama(5) = "777E Weekly"
    Nama(6) = "777D Process Weekly"
    Nama(7) = "785C Weekly"
    Nama(8) = "CAT340SSA"

    For item = 1 To 8
    With Sheets(Nama(item))
    'Mencari Posisi Akhir Column
    Columndata = .Cells(4, Columns.Count).End(xlToLeft).Column - 2
    If Item = 1 Then
    A= 1
    Else
    A=0
    End IF
    'memindah data dari WTD Plan Ke Plan
    .Cells(5, Columndata - 1) = .Cells(9 + A, Columndata)
    'memindah data dari WTD Actual Ke Actual
    .Cells(6, Columndata - 1) = .Cells(10+ A, Columndata)
    'memindah data dari Normalisasi Ke PA Normalisasi
    .Cells(7, Columndata - 1) = .Cells(11+ A, Columndata)
    'Mengisi Target Dengan Angka 85%
    .Cells(8 + A, Columndata - 1) = 85 / 100
    End With
    Next item

    End Sub

  16. Mas @Herry apa bisa saya minta file excelnya ya?. Script saya copy ke macronya masih ada yang error.
    Sudah saya coba perbaiki yang error namun masih muncul .

  17. Kurang ini
    Untuk Kode Ini ada Kelupaan Ganti dari 2 menjadi 4 (ada dua angka 2 yang perlu diganti menjadi 4)
    .Cells(4, Columndata) = "Week "&Format(Right(.Cells(4, Columndata - 1), 2) + 1,"00")

  18. Mas @Herry Luar biasa. Terima kasih banyak.

  19. sama sama

 

atau Mendaftar untuk ikut berdiskusi!