Dear Master,
Dibawah ini saya mempunyai code VBA untuk mengkopy data dari worksheet berbeda
dengan menggunakan Dua Tombol, saya mengkopi data di satu worksheet tetapi dua
kali kerja yaitu tombol pertama saya harus mengkopi ITEM CODE nya, kedua saya
tekan tombol yang kedua untuk mengkopi DATA nya. Nah bagaimana caranya hanya
dengan menggunakan satu buah tombol untuk menyelesaikan dua pekerjaan tersebut.
Kemudian pertanyaan saya yang kedua, bagaimana caranya ketika function open
file, agar semua jenis file Excel bisa muncul semua, karena yang sekarang saya
harus memilih versi 2003 atau 2010.
/////////////////////////////////////////////////////////////////////////////////
Sub CopySenin()
FileTerpilih = Application.GetOpenFilename _
("Excel 2010(*.xlsx),*.xlsx, Excel 2003 (*.xls),*.xls", Title:="Open file",
MultiSelect:=True)
If VarType(FileTerpilih) = vbBoolean Then
Exit Sub
End If
NamaFileUtama = ActiveWorkbook.Name
JumlahFile = UBound(FileTerpilih)
Application.DisplayAlerts = False
For i = 1 To JumlahFile
Workbooks.Open FileTerpilih(i)
With ActiveWorkbook.Worksheets(1)
Selection.AutoFilter Field:=3, Criteria1:=1000
ActiveWorkbook.Save
BarisTerakhirFilePilihan = .Cells(.Rows.Count, 1).End(xlUp).Row
BarisTerakhirFileUtama = Workbooks(NamaFileUtama).Worksheets(1) _
.Cells(Workbooks(NamaFileUtama).Worksheets(1).Rows.Count,
1).End(xlUp).Row
.Range("B2:B50").Copy
End With
With Workbooks(NamaFileUtama).Worksheets(2)
.Range("C202").PasteSpecial Paste:=xlValues, Transpose:=True
End With
ActiveWorkbook.Close
Next i
Application.DisplayAlerts = True
End Sub
Sub CopyDataSenin()
FileTerpilih = Application.GetOpenFilename _
("Excel 2010(*.xlsx),*.xlsx, Excel 2003 (*.xls),*.xls", Title:="Open file",
MultiSelect:=True)
If VarType(FileTerpilih) = vbBoolean Then
Exit Sub
End If
NamaFileUtama = ActiveWorkbook.Name
JumlahFile = UBound(FileTerpilih)
Application.DisplayAlerts = False
For i = 1 To JumlahFile
Workbooks.Open FileTerpilih(i)
With ActiveWorkbook.Worksheets(1)
BarisTerakhirFilePilihan = .Cells(.Rows.Count, 1).End(xlUp).Row
BarisTerakhirFileUtama = Workbooks(NamaFileUtama).Worksheets(1) _
.Cells(Workbooks(NamaFileUtama).Worksheets(1).Rows.Count,
1).End(xlUp).Row
.Range("X2:X50").Copy
End With
With Workbooks(NamaFileUtama).Worksheets(2)
.Range("C203").PasteSpecial Paste:=xlValues, Transpose:=True
End With
ActiveWorkbook.Close
Next i
Application.DisplayAlerts = True
End Sub
/////////////////////////////////////////////////////////////////////////////////////////////
Atas pencerahannya saya ucapkan banyak terima kasih,
Salam,
Odhy
