Copy Multi Sheet Excel

Setelah sekian lama, dihadapkan pada permasalahan dunia, akhirnya bisa bikin postingan juga, walaupun pikiran terpecah belah.
Tetapi pertanyaan, seperti sebuah tantangan, dan hal tersebut seperti sebuah hiburan, melepaskan semua permasalahan walau sejenak.
Halah... koq jadi curhat, langsung saja, copy multi sheet excel ini aku bagi menjadi 3 perintah :

1. Melakukan Copy berdasarkan range yang telah ditentukan
2. Melakukan copy berdasarkan kolom masing-masing sheet yang telah ditentukan
3. Melakukan Copy Data sheet saja disetiap worksheet yang ada

Langsung saja kodenya bisa dilihat dibawah ini:

Option Explicit
Dim ws As Worksheet
Dim ws1 As Worksheet

Sub copymultirangesheet()

On Error Resume Next
'kalau ada sheet hasil maka delete tanpa peringatan
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("HASIL").Delete
Application.DisplayAlerts = True

'menambahkan sheet dengan nama HASIL
Set ws = ActiveWorkbook.Worksheets.Add
ws.Name = "HASIL"

For Each ws1 In Worksheets
If ws1.Name <> "HASIL" Then 'untuk worksheet yang namanya tidak sama dengan HOME
ws1.Range("A2:E2").Copy 'copy range A2:E2
ws.Range("A1:E1").Value = ws1.Range("A1:E1").Value 'membuat judul
With ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) 'copy range ke worksheet HASIL
.PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteFormats)
End With

End If
Next ws1
With ws 'kondisi untuk hasil copy di sheet HASIL
.Range("A1:E1").Font.Bold = True
.Columns.AutoFit
.Range("A1").Select
End With
End Sub
Sub copymultikolomsheet()
'kalau ada sheet hasil maka delete tanpa peringatan
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("HASIL").Delete
Application.DisplayAlerts = True

'menambahkan sheet dengan nama HASIL
Set ws = ActiveWorkbook.Worksheets.Add
ws.Name = "HASIL"

For Each ws1 In Worksheets
If ws1.Name <> "HASIL" Then 'untuk worksheet yang namanya tidak sama dengan HOME
ws1.Range("A:A").Copy 'copy data di kolom A

With ws.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) 'paste ke sheet hasil
.PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteFormats)

End With

End If

Next ws1
With ws 'kondisi untuk di sheet HASIL
.Range("A:A").Delete
.Range("A1:E1").Font.Bold = True
.Columns.AutoFit
.Range("A1").Select
End With


End Sub
Sub copymultidatasheet()
Dim rngku As Range

'kalau ada sheet hasil maka delete tanpa peringatan
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("HASIL").Delete
Application.DisplayAlerts = True

'menambahkan sheet dengan nama HASIL
Set ws = ActiveWorkbook.Worksheets.Add
ws.Name = "HASIL"

For Each ws1 In Worksheets
Set rngku = ws1.Range("A2", ws1.Cells(ws1.UsedRange.Row + ws1.UsedRange.Rows.Count, ws1.UsedRange.Column + ws1.UsedRange.Columns.Count)) 'setting range untuk di copy
If ws1.Name <> "Hasil" Then
rngku.Copy
ws.Range("A1:E1").Value = ws1.Range("A1:E1").Value
With ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 'copy data ke sheet HASIL
.PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteFormats)
End With
End If
Next ws1
With ws 'kondisi untuk sheet HASIL
.Range("A1:E1").Font.Bold = True
.Columns.AutoFit
.Range("A1").Select
End With

End Sub

Contohnya bisa di langsung di DOWNLOAD disini