Page 1 of 1
สอบถามครับexcel copy ข้าม file
Posted: Fri Jul 20, 2018 9:38 am
by Leng
อยากก็อปปี้ข้อมูลูจาก Excel ในชีต Out ไปลงในworkbookอื่นที่อยู่ในในไดร์ D และให้runต่อๆกันครับ
Code: Select all
Private Sub CommandButton1_Click()
With Sheets("IN")
lr = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A3:I5000" & lr).Copy
Sheets("Out").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues
Workbooks.Open Filename:="C:\Users\Administrator\Desktop\Test\Data.xlsx"
lr = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A3:I5000" & lr).Copy
Sheets("Out2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues
Re: สอบถามครับexcel copy ข้าม file
Posted: Fri Jul 20, 2018 10:06 pm
by snasui
แนบไฟล์ประกอบพร้อมทั้งชี้ให้เห็นว่าปัจจุบันเกิดปัญหาที่ตรงไหน อย่างไร จะได้สะดวกในการทดสอบและแก้ไขปัญหาครับ
Re: สอบถามครับexcel copy ข้าม file
Posted: Mon Jul 23, 2018 10:19 am
by Leng
1.ต้องการเซฟข้อมูลจากไฟล์ที่ชื่อว่า fainal-copy ในชีท Out ออกมาหน้าเดสก์ท็อปโค๊ดที่ผมใช้สามารถทำงานได้ครับ
Code: Select all
Sheets("Out").Select
Sheets("Out").Copy
Sheets("Out").Select
Sheets("Out").Activate
Sheets("Out").UsedRange.Copy
ActiveWorkbook.SaveAs "C:\Users\Administrator\Desktop\" & "Agrade" & Format(Now(), "DD-MMM-YYYY hh mm AMPM") & ".xlsx", 51
ActiveWorkbook.Close
Sheets("IN").Select
Range("A3:I1048576").Clear
Selection.ClearContents
Sheets("Out").Select
Range("A2:I1048576").Select
Selection.ClearContents
MsgBox "Done:"
Worksheets("IN").Select
2.แต่ปัญหาคือผมอยาก copy ข้อมูลจาก ไฟล์ fainal-copy ในชีท Out ให้มาบันทึกในไฟล์ Data ด้วยครับ โดยให้ข้อมูลเรียงต่อๆกัน
Code: Select all
Private Sub CommandButton1_Click()
With Sheets("IN")
lr = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A3:I5000" & lr).Copy
Sheets("Out").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues
Workbooks.Open Filename:="C:\Users\Administrator\Desktop\Test\Data.xlsx"
lr = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A3:I5000" & lr).Copy
Sheets("Out").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues
Re: สอบถามครับexcel copy ข้าม file
Posted: Mon Jul 23, 2018 8:19 pm
by snasui
ตัวอย่าง Code ครับ
Code: Select all
Private Sub CommandButton1_Click()
Dim sc As Range, tg As Range
Dim tgBook As Workbook
With Sheets("IN")
lr = .Range("A" & Rows.Count).End(xlUp).Row
Set sc = .Range("A3:I5000" & lr)
sc.Copy
Sheets("Out").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues
Set tgBook = Workbooks.Open(Filename:="C:\Users\Administrator\Desktop\Test\Data.xlsm")
sc.Copy
tgBook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues
'Other code...
Re: สอบถามครับexcel copy ข้าม file
Posted: Tue Jul 24, 2018 11:24 am
by Leng
อาจารย์ครับผมไม่ต้องการให้ Workbooks = Data.xlsx เปิดขึ้นมาครับเพราะว่าถ้าเปิดไฟล์นี้มาจะไม่สามารถ run ในโค๊ดต่อๆ ไป ที่อยู่ในไฟล์ final-copy ได้ครับ
Re: สอบถามครับexcel copy ข้าม file
Posted: Tue Jul 24, 2018 7:08 pm
by snasui
การไม่เปิดจะเขียน Code ยากมากเพราะต้องใช้ Statement ของ SQL จึงจะบันทึกค่าเข้าไปในไฟล์ที่ปิดอยู่ได้ ลองเขียนมาเองก่อน ติดแล้วค่อยถามกันต่อครับ
Re: สอบถามครับexcel copy ข้าม file
Posted: Wed Jul 25, 2018 8:48 am
by Leng
ทำได้ละครับ
Code: Select all
Private Sub CommandButton1_Click()
Dim sc As Range, tg As Range
Dim tgBook As Workbook
With Sheets("IN")
lr = .Range("A" & Rows.Count).End(xlUp).Row
Set sc = .Range("A3:I5000" & lr)
sc.Copy
Sheets("Out").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues
Set tgBook = Workbooks.Open(Filename:="C:\Users\Administrator\Desktop\Test\Data.xlsx")
sc.Copy
tgBook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues
ActiveWorkbook.Save
ActiveWorkbook.Close False
Sheets("Out").Select
Sheets("Out").Copy
Sheets("Out").Select
Sheets("Out").Activate
Sheets("Out").UsedRange.Copy
ActiveWorkbook.SaveAs "C:\Users\Administrator\Desktop\" & "Agrade" & Format(Now(), "DD-MMM-YYYY hh mm AMPM") & ".xlsx", 51
ActiveWorkbook.Close
Sheets("IN").Select
Range("A3:I1048576").Clear
Selection.ClearContents
Sheets("Out").Select
Range("A2:I1048576").Select
Selection.ClearContents
MsgBox "Done:"
Worksheets("IN").Select
End With
End Sub