Sayangnya tidak ada penjelasan tidak berjalan itu seperti apa. Namun jika yang dimaksud tidak berjalan itu terjadi karena kesalahan seperti pada gambar berikut:

maka hal itu terjadi karena jumlah sel atau ukuran range yang disalin lebih banyak atau lebih besar dari ukuran sel atau range tujuan. Coba lakukan secara manual, sorot (seleksi) kolom A pada sheet FORM dengan mengklik header kolom A, kemudian salin (Copy). Kemudian pilih salah satu sel pada kolom berbeda (misalkan sel B5) dan tempelkan (Paste As Values). Lihat apa yang terjadi. Excel akan menampilkan pesan kesalahan yang sama.

Sheets("form").Select
Range("a:a").Select
Selection.Copy

Perintah di atas akan membuat seluruh baris pada kolom A disorot (dipilih). Untuk Excel 2007 ke atas, artinya pilih seluruh sel dimulai dari sel A1 sampai dengan sel A1048576. Jika kita menempelkan sel atau range yang telah disalin tersebut pada sel B5, artinya hanya 1.048.572 sel yang dapat ditempelkan. Kurang 4 sel lagi... Kecuali range tujuan dimulai dari baris pertama (misalkan B1).

Mungkin demikian masalahnya... ;)

bisa lampirkan file terkait mas @absetiawan18 ... biar lebih jelas persoalannya.

mungkin jika filenya ada rekan rekan disini bisa memberi solusinya....

@Fujiansyah92 bisa lampirkan file terkait mas @absetiawan18 ... biar lebih jelas persoalannya. mungkin jika filenya ada rekan rekan disini bisa memberi solusinya....

Saya setuju dengan mas @Fujiansyah92 ... :) Baris kode yang mas @Absetiawan18 sampaikan di atas tidak akan banyak membantu rekan-rekan dalam melacak masalahnya. Setidaknya, jika hanya mengandalkan prediksi, saya sendiri hanya bisa memprediksi masalahnya sebagaimana yang telah saya utarakan di atas. Meski saat ini saya melihat sudah ada perubahan kode VBA-nya khususnya dari baris:

Set rngX = Worksheets("DATABASE").Range("1:10000").Find( ... )

menjadi:

Set rngX = Worksheets("DATABASE").Range("1:1").Find( ... )

sehingga kemungkinan kesalahan berkurang. Namun untuk memahami proses sebenarnya, akan lebih baik jika bisa dilakukan debugging (pelacakan kesalahan) terhadap baris kodenya secara langsung... ^_^;

Saya buat script baru sepert ini :

Sub NewSave()
Dim rngX  As Range
Dim strdata1, strdata2

'Find with multiple criteria
   
    'Copy data from rekam a sheet
    Application.ScreenUpdating = False
   
    Sheets("form").Select
    Range("A1").FormulaR1C1 = "=INPUT!R[2]C[1]"
    Range("a:a").Select
    Selection.Copy

With Sheets("INPUT")
    strdata1 = .Range("B1").Value 'jenis kayu
    strdata2 = .Range("B3").Value 'batch no
End With

If Application.WorksheetFunction.CountIfs(Worksheets("database").Range("2:2"), strdata1, Worksheets("database").Range("1:1"), strdata2) > 0 Then
'if Data was found------------------------------------------------------------------------------------------------------
Worksheets("database").Select
Worksheets("database").Range("2:2").Find(strdata1, LookIn:=xlValues, MatchCase:=False).Activate
Do Until ActiveCell.Offset(-1, 0).Value = strdata2
Worksheets("database").Range("2:2").FindNext(After:=ActiveCell).Activate
Loop


       ActiveCell.Offset(-1, 0).Select
             
       'Past data changes
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("input").Select
    MsgBox "Row Updated"

Else
'if Data was not found------------------------------------------------------------------------------------------------------
 'Copy Macro
  Sheets("Input").Select
  Range("B3").Select
ActiveCell.FormulaR1C1 = "=MAX(COUNTIF(database!r2c1:r2c500,input!r1c2)+1)"
 Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
   Sheets("form").Select
    Range("a1").FormulaR1C1 = "=MAX(COUNTIF(database!r2c1:r2c500,input!r1c2)+1)"
    
    
    Range("a:a").Offset(0, 0).Select
    Selection.Copy
 

    Sheets("database").Select
    Worksheets("DATABASE").Cells(Rows.Count, "A").End(xlUp).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=False
    'ActiveSheet.Paste
    ActiveCell.Offset(1).EntireColumn.Insert
    
    Sheets("input").Select
    MsgBox "Penyalinan berhasil!", vbInformation, "Informasi"

End If

Application.ScreenUpdating = True

End Sub

file terlampir ya

saya hanya agak bingung dengan batch numbernya.. semoga tdk salah asumsi yah

untuk rekan lain,silahkan menambahkan/ada solusi lain...

Secara teknis,script terbaru itu akan melakukan pencarian dg 2 kriteria yaitu nama kayu dan batch yg sama .(Sedangkan script lama, hanya akan mencari berdasarkan kriteria tunggal). Jika ditemukan,maka akan update data sesuai sheet input ke database,namun jika tdk ditemukan [walau salah satu dari 2 kriteria ditemukan] , akan membuat data baru(insert new column) .
Untuk pembuatan No.batch,saya menggunakan script lama. [If found]: saya menggunakan No. batch sesuai inputan{sheet input} .[If not found] : saya menggunakan countif dg kriteria batch.

Saya agak ragu untuk case pembuatan No.batch.mungkin harusnya sama antara [found] & [not found] kategori .

File terlampir ya..

semoga membantu

Coba dirincikan maksudnya mau seperti apa?

@absetiawan18 @Caton dan @Fujiansyah92

mau tanya dengan kode
Dim wsSheet As Worksheet
Dim rngX As Range
Dim strdata1, strdata2, mysht

terutama yang mysht strdata1 dan strdata2 mohon penjelasannya.

karena jika ingin rubah cellnya tetap tdk mau pindah. contoh

With Sheets("INPUT")
mysht = .Range("B1").Value 'jenis kayu
strdata1 = .Range("B1").Value 'jenis kayu
strdata2 = .Range("B3").Value 'batch no

mysht = .Range("B1").Value 'jenis kayu ==> B1 saya rubah ke B4, setelah di jalankan hasilnya tetap di B1

coba upload file nya juga yg sudah dirubah. Secara penjelasan..kemungkinannya seperti ini
(1) Itu kan hanya sebagai trigger nama sheet.Jika range tsb (misal range B4) blank...maka akan tdk jalan (karena nama sheet,tdk bisa blank
(2) Logika di script tsb itu adalah...

• mysht sbg trigger nama sheet & data input
• strdata1 sbg trigger pertama untuk membaca/menentukan letak kolom target
• strdata2 sbg trigger kedua untuk membaca/menentukan letak kolom target

@absetiawan18 Dim wsSheet As Worksheet
Dim rngX As Range
Dim strdata1, strdata2, mysht

On Error Resume Next
'Find with multiple criteria

With Sheets("INPUT")
mysht = .Range("B1").Value 'jenis kayu
strdata1 = .Range("B1").Value 'jenis kayu
strdata2 = .Range("B3").Value 'batch no
End With

If Application.WorksheetFunction.CountIfs(Worksheets(mysht).Range("2:2"), strdata1, Worksheets(mysht).Range("1:1"), strdata2) > 0 Then
'if Data was found------------------------------------------------------------------------------------------------------

Set wsSheet = Sheets(mysht)
If Not wsSheet Is Nothing Then
Sheets(mysht).Select
Else
Worksheets.Add
ActiveSheet.Name = mysht
End If

Worksheets(mysht).Select
Worksheets(mysht).Range("2:2").Find(strdata1, LookIn:=xlValues, MatchCase:=False).Activate
Do Until ActiveCell.Offset(-1, 0).Value = strdata2
Worksheets(mysht).Range("2:2").FindNext(After:=ActiveCell).Activate
Loop

untuk case ini,

coba pakai ini :

Sub Find_Data()
Dim wsSheet As Worksheet
Dim rngX As Range
Dim strdata1, strdata2, mysht

On Error Resume Next
'Find with multiple criteria

With Sheets("INPUT")
mysht = .Range("B1").Value 'jenis kayu
strdata1 = .Range("B1").Value 'jenis kayu
strdata2 = .Range("B3").Value 'batch no
End With

If Application.WorksheetFunction.CountIfs(Worksheets(mysht).Range("2:2"), strdata1, Worksheets(mysht).Range("1:1"), strdata2) > 0 Then
'if Data was found------------------------------------------------------------------------------------------------------
MsgBox "Data was found !!", vbInformation, "Found"
Worksheets(mysht).Select
Worksheets(mysht).Range("2:2").Find(strdata1, LookIn:=xlValues, MatchCase:=False).Activate
Do Until ActiveCell.Offset(-1, 0).Value = strdata2
Worksheets(mysht).Range("2:2").FindNext(After:=ActiveCell).Activate
Loop
Else
MsgBox "Data was not found !!", vbCritical, "Not Found"
End If
End Sub