Code lưu sheet thành file xlsx (1 người xem)

[hongdaisu]

Chào mọi người
Mình có 1 file như đính kèm: mình muốn lưu kết quả chỉ (sheet 3) ra thành file đuôi xlsx.nhưng chỉ lưu dữ liệu từ cột A ->I và tự chèn cột số thứ tự .vì dự liệu sheet3 được lọc tự động từ sheet 1 và sheet 2

 

[nmhung49]

Chào mọi người
Mình có 1 file như đính kèm: mình muốn lưu kết quả chỉ (sheet 3) ra thành file đuôi xlsx.nhưng chỉ lưu dữ liệu từ cột A ->I và tự chèn cột số thứ tự .vì dự liệu sheet3 được lọc tự động từ sheet 1 và sheet 2

Muốn đính kèm file nhấn vào nút sửa bài viết rồi đính kèm file đừng gửi 2 bài viết cùng nhau trong 1 chủ đề. Thân
[GPECODE=vb]
Sub Test()
Sheets("Sheet3").Copy 'Thay doi ten sheet muon copy
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & Format(Now(), "ddmmyymmss"), FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
.Close (False)
End With
End Sub


[/GPECODE]

 

[hongdaisu]

code này tạo ra module rồi pass vào hay pass trực tiếp vào sheet3-mình mún tạo 1 macro
bạn đóng khung dữ liệu luôn được không-ví dụ dữ liệu từ dòng thứ 5 trở xuống

 

[nmhung49]

code này tạo ra module rồi pass vào hay pass trực tiếp vào sheet3-mình mún tạo 1 macro
bạn đóng khung dữ liệu luôn được không-ví dụ dữ liệu từ dòng thứ 5 trở xuống

Copy chỗ nào cũng được module hay sheet điều chạy được đóng khung thì thêm code này vào

[GPECODE=vb]
Sub Test()
Sheets("Sheet3").Copy
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & Format(Now(), "ddmmyymmss"), FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
With .ActiveSheet
.Range("A5:I" & .Range("I65000").End(xlUp).Row).Borders.LineStyle = 1
End With
.Close (True)
End With
End Sub


[/GPECODE]

 

[hongdaisu]

trước hết cảm ơn sự nhiệt tình của bạn
Ý của mình là thay vì mình bấm vào nút lưu riêng sheet3 thành 1 file mới thì mình cần code để chỉ lưu vùng A-.I ra thành 1 file mới bạn ah (lưu ra desktop chẳng hạn)
code đóng khung của bạn nó chạy nhưng mất khung sau đó

 

[nmhung49]

trước hết cảm ơn sự nhiệt tình của bạn
Ý của mình là thay vì mình bấm vào nút lưu riêng sheet3 thành 1 file mới thì mình cần code để chỉ lưu vùng A-.I ra thành 1 file mới bạn ah (lưu ra desktop chẳng hạn)
code đóng khung của bạn nó chạy nhưng mất khung sau đó

Bạn Thử code này lại xem

[GPECODE=vb]
Sub Test()
Dim Vitriluu As String
Vitriluu = "C:\Users\Hung\Desktop\"
Sheets("Sheet3").Range("A:I").Copy
Workbooks.Add: ActiveSheet.Paste
With ActiveWorkbook
.SaveAs Vitriluu & "GPE" & Format(Now(), "ddmmyymmss"), FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
With ActiveSheet
.Range("A5:I" & .Range("I65000").End(xlUp).Row).Borders.LineStyle = 1
End With
.Close (True)
End With
End Sub


[/GPECODE]

 

[hongdaisu]

Không chạy dc bạn ah

 

[Ba Tê]

Không chạy dc bạn ah

Thử sub này xem, copy nguyên xi từ cột A-I.

Sub GPE()
Dim Pat As String, FName As String
    Pat = "D:\ChoNaoDo\"    '--------------O dia, thu muc'
    FName = "TenGiDo.xlsx"     '--------------Ten File'
    Sheets("Sheet3").Copy
    Columns("J:IV").Clear
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:=Pat & FName
End Sub

 

[ndu96081631]

Bạn Thử code này lại xem

Sub Test()
Dim Vitriluu As String
[COLOR=#ff0000]Vitriluu = "C:\Users\Hung\Desktop\"[/COLOR]
Sheets("Sheet3").Range("A:I").Copy
Workbooks.Add: ActiveSheet.Paste
With ActiveWorkbook
    .SaveAs Vitriluu & "GPE" & Format(Now(), "ddmmyymmss"), FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False
    With ActiveSheet
        .Range("A5:I" & .Range("I65000").End(xlUp).Row).Borders.LineStyle = 1
    End With
    .Close (True)
End With
End Sub

Cũng chưa chắc người dùng biết sửa cái chỗ màu đỏ cho đúng cái Desktop trên máy họ đâu
Vậy thì: Đố biết làm sao viết code tổng quát cho trường hợp này?
Ẹc... Ẹc...

 

[huy vu]

Cũng chưa chắc người dùng biết sửa cái chỗ màu đỏ cho đúng cái Desktop trên máy họ đâu
Vậy thì: Đố biết làm sao viết code tổng quát cho trường hợp này?
Ẹc... Ẹc...

Có phải worksheet.path để cho cùng thư mục luôn.

 

[nmhung49]

Cũng chưa chắc người dùng biết sửa cái chỗ màu đỏ cho đúng cái Desktop trên máy họ đâu
Vậy thì: Đố biết làm sao viết code tổng quát cho trường hợp này?
Ẹc... Ẹc...

Em nghĩ có thể dùng code này mới kiểm tra trên win 7 không biết các phiên bản khác thể nào

Vitriluu= CreateObject("WScript.Shell").Specialfolders("Desktop")

 

[ndu96081631]

Em nghĩ có thể dùng code này mới kiểm tra trên win 7 không biết các phiên bản khác thể nào

Vitriluu= CreateObject("WScript.Shell").Specialfolders("Desktop")

Đó cũng là cách đơn giản. Ngoài ra còn có hàng đống cách khác nữa. Các bạn có thể tìm trên Google từ khóa: Excel VBA Get Special Folder để biết thêm
Nói chung đây là chuyện ngoài lề, ta sẽ bàn vào dịp khác. Điều mà tôi muốn nói ở đây là: SỰ TỔNG QUÁT CỦA CODE