สอบถามครับexcel copy ข้าม file

[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

[snasui]

แนบไฟล์ประกอบพร้อมทั้งชี้ให้เห็นว่าปัจจุบันเกิดปัญหาที่ตรงไหน อย่างไร จะได้สะดวกในการทดสอบและแก้ไขปัญหาครับ

[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

[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...

[Leng]

อาจารย์ครับผมไม่ต้องการให้ Workbooks = Data.xlsx เปิดขึ้นมาครับเพราะว่าถ้าเปิดไฟล์นี้มาจะไม่สามารถ run ในโค๊ดต่อๆ ไป ที่อยู่ในไฟล์ final-copy ได้ครับ

[snasui]

การไม่เปิดจะเขียน Code ยากมากเพราะต้องใช้ Statement ของ SQL จึงจะบันทึกค่าเข้าไปในไฟล์ที่ปิดอยู่ได้ ลองเขียนมาเองก่อน ติดแล้วค่อยถามกันต่อครับ

[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