Xin hỗ trợ sửa hàm vba copy file

[beetune1991]

Xin chào anh chị,

Trong file đính kèm em gửi phát sinh một lỗi là khi copy ra file excel là
* không giữ nguyên form file gốc
*biến mất hết các cột vẽ
*chỉ còn chữ

Anh chị giúp em viết lại code với ạ.
Nếu được anh chị giúp em xem e bị sai ở chỗ nào với ạ

Em xin cảm ơn,

 

[phuongvq123]

tốt hơn là bạn đăng vào mục lập trình

 

[khitamdao]

"Range("A1").PasteSpecial Paste:=xlPasteValues"
=> Đây là code paste giá trị, nên mọi định dạnh đều bị mất hết

 

[beetune1991]

"Range("A1").PasteSpecial Paste:=xlPasteValues"
=> Đây là code paste giá trị, nên mọi định dạnh đều bị mất hết

không được anh ạ

 

[khitamdao]

không được anh ạ

- Mình đã thử cũng không được.
- Bạn có thể làm theo cách là copy hẳn các sheet này sang file mới chứ không copy từng nội dung bên trong như hiện tại.

- Để được hỗ trợ nhanh thì nên hỏi trong mục lập trình vba (như bác bên trên nói)

 

[beetune1991]

- Mình đã thử cũng không được.
- Bạn có thể làm theo cách là copy hẳn các sheet này sang file mới chứ không copy từng nội dung bên trong như hiện tại.

- Để được hỗ trợ nhanh thì nên hỏi trong mục lập trình vba (như bác bên trên nói)

thế anh viết giúp em code copy sang sheet mới excel và pdf giúp e với ạ

 

[khitamdao]

code này đảm nhận việc copy và giữ định dạng.
Còn pdf thì hình như có code rồi mà

Private Sub CommandButton1_Click()
Dim sArr(), Wb As Workbook, NewWb As Workbook, NewWs As Worksheet, i&, j&, k&
Set Wb = ActiveWorkbook
Set NewWb = Workbooks.Add
j = NewWb.Sheets.Count
For i = 0 To LB1.ListCount - 1
If LB1.Selected(i) Then
k = k + 1
'sArr = Wb.Sheets(LB1.List(i)).UsedRange.Copy
Wb.Sheets(LB1.List(i)).UsedRange.Copy
If k <= j Then
Sheets("Sheet" & k).Select
With NewWb.Sheets("Sheet" & k)
'.Range("A1").Resize(UBound(sArr), UBound(sArr, 2)) = sArr
.Range("A1").Select
.Paste
.PasteSpecial xlPasteColumnWidths
.Name = LB1.List(i)
End With
Else
With NewWb
.Sheets.Add After:=.Sheets(.Sheets.Count)
Set NewWs = ActiveSheet
With NewWs
'.Range("A1").Resize(UBound(sArr), UBound(sArr, 2)) = sArr
.Range("A1").Select
.Paste
.PasteSpecial xlPasteColumnWidths
.Name = LB1.List(i)
End With
End With
End If
End If
Next
End Sub

- Mình đã thử cũng không được.
- Bạn có thể làm theo cách là copy hẳn các sheet này sang file mới chứ không copy từng nội dung bên trong như hiện tại.

- Để được hỗ trợ nhanh thì nên hỏi trong mục lập trình vba (như bác bên trên nói)

Bài đã được tự động gộp: 14/1/21

thế anh viết giúp em code copy sang sheet mới excel và pdf giúp e với ạ

- Code xuất ra PDF, xuất tất cả Sheet ra 1 file pdf duy nhất.
- Trước khi xuất PDF nên đặt mỗi sheet có độ rộng vừa 1 khổ A4 cho đẹp, chứ như cài đặt hiện tại thì xuất pdf ra rất xấu.
- Hy vọng là đúng ý của bạn.
- Sheets(Array("Nhaplieu", "1", "2", "3", "4", "5")).Select
code này là chọn các sheet, bạn để nó ý như phần check box là ổn

code:
Sheets(Array("Nhaplieu", "1", "2", "3", "4", "5")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\May01\Downloads\lam th?.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False