2017-10-05 9 views
0

저는 주 오래된 워크 시트를 보관하는 방법을 알아 내려고하고 있습니다.일일 워크 시트 만들기, 지난 주 워크 시트 보관

내 프로젝트에 약간의 배경 :

나는 두 개의 새로운 워크 시트 내가 매일 검토 일일 보고서 요약 및 계산을 수용 매일을 만듭니다. 현재로서는 엑셀 파일에서 너무 많은 워크 시트가 열리는 방법이 있기 때문에 열어 사람들에게 보낼 때 시간이 오래 걸립니다.

궁극적으로 지난 주에 작성된 워크 시트를 다른 파일에 저장하는 방법을 알고 싶습니다. 나는이 모든 것을 개별 (단일) 통합 문서에 저장하고 싶습니다. 그렇지 않으면 그 주마다 매일 각 통합 문서를 저장할 폴더를 어떻게 든 만들고 싶습니다.

예를 들어 이번 주에 10 개의 워크 시트를 만듭니다 (월간 2 개, 월 - 금). 그런 다음 월요일에 다음 월요일에 워크 시트를 만들 때 이전 시트를 다른 워크 북에 넣을 수 있습니다.

나는 현재 매일 워크 시트를 만드는 데 사용하는 코드 :

TD = Format(Date, "yyyy.mm.dd") 

On Error GoTo Make_Sheet 
    Sheets("Open_" & TD).Activate 

    Sheets("Open_" & TD).Select 
    Cells.Select 
    Selection.Delete Shift:=x1Up 
Exit Sub 

    Make_Sheet: 
     Worksheets.Add(After:=Sheets("Print")).Name = "Open_" & TD 
     ActiveSheet.Name = "Open_" & TD 

With ActiveWorkbook.Sheets("Open_" & TD).Tab 
    .Color = 5296274 
    .TintAndShade = 0 
End With 

코드는 현재 날짜의 워크 시트가 이미 (워크 시트의 제목과 날짜를 사용) 존재하는지 확인합니다, 그것은 경우 그것을 지우는가? 그렇지 않으면 새 워크 시트가 만들어집니다. 또한 탭을 색상 코드로 지정합니다 (매일 2를 만들기 때문에). 두 번째 일일 워크 시트를 작성하는 또 다른 동일한 코드 세트가 있습니다. 사전에

감사합니다,

-Tuques 여기

+0

모두 '활성화'및 '선택'으로 인해 속도가 느려집니다. 예제를 사용하지 않기 위해 코드를 재구성하십시오 ..'Cells.Delete Shift : = x1Up'은 select를 사용하여 2 줄에있는 것과 같은 일을합니다. – braX

+0

질문과 관련이 없지만 'Shift : = x1Up'을'Shift : = xlUp'으로 변경하십시오. – YowE3K

답변

0

는 새 통합 문서를 새 통합 문서에 모든 시트를 복사하여 저장하고 닫습니다 매크로입니다. 첫 번째 시트를 제외한 모든 시트를 삭제 한 다음 나머지 시트의 내용을 지 웁니다. 보존 할 시트가 확실하지 않습니다.

Sub New_week() 
NWeek = MsgBox("Is this the start of a new week?", vbYesNo + vbQuestion) 

    If NWeek = 6 Then 

     Dim fname As String 
     'Create new Workbook name. 
     'Add path if you want it in a specific folder 
    fname = "Week" & Format(Date, "yyyy_mm_dd") & ".XLSX" 
     'copy all sheets 
    Sheets.Copy 
     'save to new file 
     With ActiveWorkbook 
     .SaveAs FileName:=fname, FileFormat:=xlOpenXMLWorkbook 
     .Close SaveChanges:=False 
     End With 

    'Delete all sheets except first 
    Application.DisplayAlerts = False 
     Do While Worksheets.Count > 1 
     Worksheets(2).Delete 
     Loop 
    Application.DisplayAlerts = True 
    'Clear contents of first sheet 
    Sheets(1).UsedRange.Clear 

    End If