Simpan beberapa data ke file Lain macro

4 tahun lalu

M

mumuskh
29 Jun 2020 + 527 Poin

Di sunting 4 tahun lalu oleh mumuskh

Assalamualaikum War. Wab
Mau tanya, kira2 apa yang kurang?, nyimpan ke file lain dari baris 4 sampai 23 tidak bisa, mohon pencerahannya dan kami lampirkan filenya.
Terimakasih sebelumnya.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
If IsFileOpen("G:\TEST\Data.xlsx") Then
MsgBox "Maaf, file 1.xlsx sedang dibuka, silahkan tutup file terlebih dahulu.."
Exit Sub
End If
Workbooks.Open FileName:="G:\TEST\Data.xlsx"
With Worksheets("Sheet1")
BarisTerakhir = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To 8
.Cells(BarisTerakhir + 1, i).Value = Me.Cells(4, i).Value
Next i
End With
Workbooks("Data.xlsx").Save
Workbooks("Data.xlsx").Close
Application.ScreenUpdating = True
End Sub
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function

Terjawab oleh mumuskh
Lihat Jawaban terkait

Terima kasih banyak pencerahannya @manweljs_
M
manweljs_
29 Jun 2020 Terverifikasi + 11.321 Poin
@mumuskh
jika yang dimaksud :
1.BarisTerakhir adalah nilai baris akhir dari Sheet1 di file Data.xlsx
2.Data yang ingin disalin adalah data dari workbook yang aktif di sheet1 range A4:H23 ke baris terakhir di sheet1 workbook Data.xlsx maka :
```
...
Dim wb As Workbook
Set wb = Workbooks.Open("G:\TEST\Data.xlsx")

With wb.Worksheets("Sheet1")
BarisTerakhir = .Cells(.Rows.Count, 1).End(xlUp).Row
thisworkbook.sheets("Sheet1").range("A4:H23").copy .cells(BarisTerakhir  + 1,1)
End With
...
```
· mumuskh menyukai ini.
M

mumuskh
29 Jun 2020 + 527 Poin

Di sunting 4 tahun lalu oleh mumuskh

betul sekali, terima kasih pencerahannya @manweljs_
tp ada yg kurang faham dikit, klo pastenya spesial sekiranya rumusnya mati gimana perintahnya?
M
manweljs_
29 Jun 2020 Terverifikasi + 11.321 Poin

Di sunting 4 tahun lalu oleh manweljs_
@mumuskh ...klo pastenya spesial sekiranya rumusnya mati gimana perintahnya?
saya gak paham apa itu 'rumusnya mati', kalo mau paste special, edit menjadi :
```
...
thisworkbook.sheets("Sheet1").range("A4:H23").copy 
.cells(BarisTerakhir  + 1,1).PasteSpecial
...
```
kalo ingin jadi value :
```
...
thisworkbook.sheets("Sheet1").range("A4:H23").copy 
.cells(BarisTerakhir  + 1,1).PasteSpecial Paste:=xlPasteValues
...
```
demikian
· mumuskh menyukai ini.
M

mumuskh
29 Jun 2020 Jawaban Terpilih + 527 Poin

Terima kasih banyak pencerahannya @manweljs_

· mumuskh menyukai ini.
M
mumuskh
30 Jun 2020 + 527 Poin

Di sunting 4 tahun lalu oleh mumuskh
Mohon maaf @manweljs_ ada yg kurang faham
stlh sy coba test printah yang diatas, save dari file Form.xlsm ke file data.xlsx, mohon solusinya supaya data yang tersimpan di data.xlsx tidak ada baris kosong
Terima kasih
Data.xlsx

FORM.xlsm

manweljs_

30 Jun 2020 Terverifikasi + 11.321 Poin

Di sunting 4 tahun lalu oleh manweljs_

coba edit menjadi :

...
Dim wb As Workbook, ws As Worksheet
Set wb = Workbooks.Open("G:\TEST\Data.xlsx")
Set ws = ThisWorkbook.Sheets("Sheet1")

With wb.Worksheets("Sheet1")
baristerakhir = .Cells(.Rows.Count, 1).End(xlUp).Row
ws.Range("A4:H" & ws.Range("A:A").Find("*", , , , xlByRows, xlPrevious).Row).Copy
.Cells(baristerakhir + 1, 1).PasteSpecial Paste:=xlPasteValues
End With
Workbooks("Data.xlsx").Close True
...

· mumuskh menyukai ini.

M
mumuskh
30 Jun 2020 + 527 Poin
Maaf @manweljs_
setelah kami test, hasil data yang terimapan di file data.xlsx masih loncat seperti gambar berikut :
terima banyak kasih pencerahannya
hasil.pdf
M
manweljs_
30 Jun 2020 Terverifikasi + 11.321 Poin
@mumuskh
kok disaya bisa ya :)
coba tambahi LookIn nya xlValues :
```
...
ws.Range("A4:H" & ws.Range("A:A").Find("*", , xlValues, , xlByRows, xlPrevious).Row).Copy
...
```
M

mumuskh
30 Jun 2020 + 527 Poin

Di sunting 4 tahun lalu oleh mumuskh

Sudah sukses, terima kasih banyak pencerahan dan ilmunya @manweljs_

· manweljs_ dan Ferryansyah menyukai ini.

Terjawab oleh mumuskh