Selamat siang, saya mau tanya ne...saya punya data pemilih dalam satu work sheet dan saya mau buat kolektif dalam satu sheet, setelah saya gabung kedalam satu sheet ternyata Nomor NIK & NKK berubah pada digit ke-16 yakni angka 0 semua.
Bagaimana caranya supaya tidak berubah Nomor NIK & NKK?
Sekian mohon pencerahan..!
-
6 tahun lalu
-
@Luthfi Aliffatuzzain
apakah ada file yang bisa dilampirkan? agar bisa diperiksa errornya dimana.
-
Di sunting 6 tahun lalu oleh Luthfi Aliffatuzzain
@manweljs_
Ini module VBA yg saya gunakan! -
Di sunting 6 tahun lalu oleh manweljs_
coba ganti rng.value menjadi rng.text
Option Explicit Sub gabung_sheet() Application.ScreenUpdating = False Dim wrk As Workbook Dim sht As Worksheet Dim trg As Worksheet Dim rng As Range Dim colCount As Integer Set wrk = ActiveWorkbook For Each sht In wrk.Worksheets If sht.Name = "Hasil" Then MsgBox "Worksheet 'Hasil' sudah ada ." & vbCrLf & _ "silahkan di delete dulu karena sheet 'Hasil' " & _ "akan menjadi hasil dari penggabugan ini.", vbOKOnly + vbExclamation, "Error" Exit Sub End If Next sht Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) trg.Name = "Hasil" Set sht = wrk.Worksheets(1) colCount = sht.Cells(1, 255).End(xlToLeft).Column With trg.Cells(1, 1).Resize(1, colCount) .Value = sht.Cells(1, 1).Resize(1, colCount).Value .Font.Bold = True End With For Each sht In wrk.Worksheets If sht.Index = wrk.Worksheets.Count Then Exit For End If Set rng = sht.Range(sht.Cells(10, 1), sht.Cells(65536, 22).End(xlUp).Resize(, colCount)) 'Ganti jadi text trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).text = rng.text Next sht trg.Columns.AutoFit Application.ScreenUpdating = True End Sub -
@manweljs_
Saya coba ganti tapi malah tidak ada hasil yang digabungkan! -
@manweljs_
Hasil yg pertama jika saya ganti menjadi value! pada digit ke-16 terdapat angka 0 semua yg tidak sesuai dengan data real -
@Luthfi Aliffatuzzain
coba dilampirkan file yang sedang dikerjakan. setidaknya 2 sheet data dan masing2 sheet berisi 20 row itu sudah cukup untuk menganalisa susunan filenya.
-
@manweljs_
Datanya seperti ini! -
Di sunting 6 tahun lalu oleh manweljs_
@Luthfi Aliffatuzzain
coba edit menjadi :
.... For Each sht In wrk.Worksheets If sht.Index = wrk.Worksheets.Count Then Exit For End If Set rng = sht.Range(sht.Cells(10, 1), sht.Cells(65536, 22).End(xlUp).Resize(, colCount)) rng.Copy trg.Cells(65536, 1).End(xlUp).Offset(1).PasteSpecial Next sht ....note : Data yang anda lampirkan dimulai dari row ke 4, sedangkan skrip anda mulai "mengcopy" dari row ke-10. jadi saya berasumsi masih ada data lain di baris 1-6 yang mungkin anda hapus pada lampiran.
-
@manweljs_
Alhamdulillah sudah berhasil... Terimakasih ya -
@manweljs_
Ya berhasil, next untuk dijadikan satu headernya maka yg kita rubah yg mana ne? -
@manweljs_
Misalnya dari sekian sheet yg saya kerjakan header tabelnya sama dan saya mau buat satu header. seperti contoh dibawah ini...maka rumus yg dirubah pada module VBA yg mana ne? -
@Luthfi Aliffatuzzain
triknya adalah dibuat dulu sheet Hasil nya (contoh terlampir)
-
@manweljs_
Ya seperti contoh yang dikirmkan, pada module VBA yg dirubah yg mana atau memang ada module tersendiri yg dibuatnya oleh @manweljs_ ! -
Di sunting 6 tahun lalu oleh manweljs_
Copy aja salah satu header ke Sheet "Hasil" kemudian gunakan skrip berikut :
Sub GabungSheet() Application.ScreenUpdating = False Dim wrk As Workbook Dim sht As Worksheet Dim trg As Worksheet Dim rng As Range Set wrk = ActiveWorkbook Set trg = Sheets("Hasil") For Each sht In wrk.Worksheets If sht.Name <> trg.Name And sht.Name <> "REKAP DPSHP KECAMATAN" Then Set rng = sht.Range("A11:N" & sht.Range("A" & Rows.Count).End(xlUp).Row) rng.Copy trg.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial End If Next sht trg.Columns.AutoFit Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
