quyenpv
Thu nhặt kiến thức
- Tham gia
- 5/1/13
- Bài viết
- 719
- Được thích
- 97
- Giới tính
- Nam
- Nghề nghiệp
- Decode cuộc đời!
Dear anh chị
Nhờ anh chị Fix lỗi muốn Copy tiêu đề từ file nguồn sang Workbook mới bị lỗi
Nhờ anh chị Fix lỗi muốn Copy tiêu đề từ file nguồn sang Workbook mới bị lỗi
Mã:
Sub CV_ChuaHoanThanh()
ActiveWorkbook.Sheets("Data").Select
Dim lr As Long
Dim lrLoc As Long
Dim sRootFolder, sFolder_Unfinished As String
Dim sDauky, sCuoiky
sRootFolder = ActiveWorkbook.Sheets("Setting").Range("K8")
sFolder_Unfinished = ActiveWorkbook.Sheets("Setting").Range("K10")
sDauky = Format(ActiveWorkbook.Sheets("Report").Range("Dauky"), "dd-mm-yyyy")
sCuoiky = Format(ActiveWorkbook.Sheets("Report").Range("cuoiky"), "dd-mm-yyyy")
Dim filename As Workbook
If Len(Dir(sRootFolder & "\" & sFolder_Unfinished, vbDirectory)) = 0 Then
MkDir (sRootFolder & "\" & sFolder_Unfinished)
End If
ActiveWorkbook.Sheets("Data").Range("A5:O5").Copy
StopCalc
Dim i&, k, Data(), Kq(), Sort(), lastRow
Data = Range(Sheets("Data").[A6], Sheets("Data").[A10000].End(3)).Resize(, 15)
ReDim Kq(1 To UBound(Data), 1 To 15)
For i = 1 To UBound(Data)
If Data(i, 11) <> "" And Data(i, 11) <> ActiveWorkbook.Sheets("Setting").Range("I2") Then
k = k + 1
Kq(k, 1) = k: Kq(k, 2) = Data(i, 2)
Kq(k, 3) = Data(i, 3): Kq(k, 4) = Data(i, 4)
Kq(k, 5) = Data(i, 5): Kq(k, 6) = Data(i, 6)
Kq(k, 7) = Data(i, 7): Kq(k, 8) = Data(i, 8)
Kq(k, 9) = Data(i, 9): Kq(k, 10) = Data(i, 10)
Kq(k, 11) = Data(i, 11): Kq(k, 12) = Data(i, 12)
Kq(k, 13) = Data(i, 13): Kq(k, 14) = Data(i, 14)
Kq(k, 15) = Data(i, 15)
End If
Next
Set filename = Workbooks.Add
Range("A5").Select
ActiveSheet.Paste
With filename.Worksheets("Sheet1")
.Range("A6").Resize(k, 15).Value = Kq
.Range("D6:d" & 6 + k).WrapText = 1
.Columns("B:B").NumberFormat = "dd/mm"
.Columns("D:D").ColumnWidth = 53
.Columns("G:G").NumberFormat = "dd/mm"
.Columns("J:J").Style = "Percent"
End With
' filename.Worksheets("Sheet1").Rows(1, 99999).Autofit
Application.DisplayAlerts = False
filename.SaveAs filename:=sRootFolder & "\" & sFolder_Unfinished & "\" & "Cong Viec Chua Hoan Thanh tu " & sDauky & " den " & sCuoiky
'ActiveWorkbook.Close
ResetCalc
'End If
End Sub
