Cách move 1 worksheet vào 1 file excel (vẫn giữ nguyên format) bằng vba

[thaihau2004]

Chào các bạn/ anh chi,

Hôm trước đc mấy anh giúp giải quyết bài toán tách chuỗi, hiện mình đã áp dụng vào công việc của mình thành công. Nay có 1 bài toán khác nhờ các anh/bạn giúp với. Đó là:

user gữi cho mình 1 cái file excel (A) (trong đó để đơn giản chỉ có 1 worksheet thôi), mình muốn copy cái worksheet này vào cái file mẹ (B) để mình xử lý code tiếp.

Mình đã đọc các bài viết về cách sữ dụng ADO trong diễn đàn, nhưng có vẻ như nó chỉ áp dụng để copy thuần dữ liệu thôi, còn cái này mình muốn move nguyên cái sheet đó qua file B luôn (nghĩa là giữ nguyên format, font, màu tô chữ, viền,..)

Các bạn xem giúp mình bài này nhé. Cám ơn rất nhiều!!

 

[ndu96081631]

Mình đã đọc các bài viết về cách sữ dụng ADO trong diễn đàn, nhưng có vẻ như nó chỉ áp dụng để copy thuần dữ liệu thôi, còn cái này mình muốn move nguyên cái sheet đó qua file B luôn (nghĩa là giữ nguyên format, font, màu tô chữ, viền,..)

Các bạn xem giúp mình bài này nhé. Cám ơn rất nhiều!!

Dùng ADO là tuyệt vời nhất cho trường hợp lấy dữ liệu từ file đang đóng rồi đấy bạn à!
Sau khi có dữ liệu xong, bạn viết thêm phần code format nữa, thiết nghĩ đâu phải chuyện khó khăn gì
(Code để tô màu, thay đổi font name, font size, kẻ khung... ta có thể record macro để biết code viết thế nào)
------------
Còn nếu như bạn nhất định muốn file đích phải có format y chang với file nguồn, bạn có thể mở nó lên, copy rồi paste sang đích (đương nhiên cũng dùng code) ---> Cái này lại quá dễ, chỉ vài dòng code là xong

 

[thaihau2004]

dạ đúng rồi, em cần file đích có format y chang file nguồn, vì file nguồn user gữi cho em nên ko biết là họ sẽ tô màu, kẻ khung ở ô nào cả.

Anh có thể hướng dẫn chi tiết hơn đc ko? em mới vào nghề nên còn gà lắm ^^'

 

[ndu96081631]

dạ đúng rồi, em cần file đích có format y chang file nguồn, vì file nguồn user gữi cho em nên ko biết là họ sẽ tô màu, kẻ khung ở ô nào cả.

Anh có thể hướng dẫn chi tiết hơn đc ko? em mới vào nghề nên còn gà lắm ^^'

Vầy là được rồi:

Public Sub Step1_Import_file()
  Dim vFile
  On Error Resume Next
  vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsx; *.xlsm")
  Application.ScreenUpdating = False
  If TypeName(vFile) = "String" Then
    Application.DisplayAlerts = False
    With Workbooks.Open(CStr(vFile), 0)
      .Sheets(1).Range("A1:C1000").Copy
      With ThisWorkbook.Sheets(1).Range("A1")
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteColumnWidths
      End With
      .Close False
    End With
    Application.CutCopyMode = 0
    Application.DisplayAlerts = True
  End If
  Application.ScreenUpdating = True
End Sub

 

[thaihau2004]

Vầy là được rồi:

Public Sub Step1_Import_file()
  Dim vFile
  On Error Resume Next
  vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsx; *.xlsm")
  Application.ScreenUpdating = False
  If TypeName(vFile) = "String" Then
    Application.DisplayAlerts = False
    With Workbooks.Open(CStr(vFile), 0)
      .Sheets(1).Range("A1:C1000").Copy
      With ThisWorkbook.Sheets(1).Range("A1")
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteColumnWidths
      End With
      .Close False
    End With
    Application.CutCopyMode = 0
    Application.DisplayAlerts = True
  End If
  Application.ScreenUpdating = True
End Sub

yeah, đúng cái em cần, chạy ngon lành cành đào. bắt đầu yêu vba rồi
Cám ơn anh ndu96081631 nhiều nhé.

Cheer

 

[langtu020690]

Hi mọi người cũng như tiêu đề trên, hiện tại e có 1 tình huống là, e có 1 file excel tổng (nhiều mã), e chạy code để nó tạo ra 1 file excel khác (file con theo từng mã) . Thì những file con này có định dạng về cột và dòng không giống như file tổng. e gửi lên nhờ mọi người xem giúp dùm e, vì trong file tổng e đã canh chỉnh độ dài và độ rộng vừa trang A4 rồi, e cũng muốn file con khi tạo ra nó cũng có format giống như file mẹ

Sub inhangloat()
Dim i As Integer
Dim DC As Long, Wb As Workbook
    DC = Sheet1.Range("H1").Value
Application.ScreenUpdating = 0
For i = 1 To DC
    Application.StatusBar = "i=" & i & "/" & DC
    DoEvents
    ThisWorkbook.Sheets(2).Cells(3, 4) = ThisWorkbook.Sheets(1).Cells(i + 3, 2)
    ThisWorkbook.Sheets(2).Cells(4, 4) = ThisWorkbook.Sheets(1).Cells(i + 3, 4)
    Set Wb = Workbooks.Add
    Wb.SaveAs ThisWorkbook.Path & "\Output\" & i & " " & Sheet2.Cells(i + 3, "D").Value
    Sheet1.Range("A1:F49").Copy Wb.Sheets(1).Range("A1")
    Wb.Close True
Next
    Application.ScreenUpdating = 1
    MsgBox "Xong!", vbInformation, "Thông báo"
End Sub

phía trên là code trong file của e, và e có đính kèm file bên dưới
p.s: do nó sinh file mới ra 1 thư mục "Output", nên khi chạy máy khác thì phải tại thư mục "Output" thì thì con sẽ tự động lưu vào đó