2013-04-29 2 views
0

매크로를 사용하여 미리 정의 된 일부 시트 만 새 통합 문서에 저장하고 싶습니다.다른 통합 문서에 일부 시트 만 저장

userform을 사용하여 새 파일의 이름을 물어본 다음 작성한 다음 열어서 이전 파일에서 새 파일로 하나씩 복사하여 붙여 넣습니다.

이것은 이미 실행하는 데 많은 시간이 걸리며, 복사 및 붙여 넣기를 위해 시트에 점점 많은 데이터를 가져올수록이 작업은 더욱 어려워 질 것입니다.

다른 방법이 있습니까? Dico_export는 시트의 이름이 포함 된 사전을 복사 할, WB 새로운 책, Ws이 오래 된 책에있는 워크 시트입니다

WB2는 오래 된 책입니다 :

여기 내 코드입니다.

For Each WS In WB2.Worksheets 
    If Dico_Export.Exists(WS.Name) Then 
     WB2.Worksheets(WS.Name).Copy after:=WB.Sheets(1 + i) 
     If WS.Name <> "Limites LPG" Then 
     tabl(i) = WS.Name 
     End If 
     i = i + 1 
    End If 
Next 
+0

새 파일로 시트를 복사하는 데 사용하는 방법은 무엇입니까? –

+0

첫 번째 도서의 각 시트에 대해 이름이 배열과 일치하는지 확인합니다. 그렇다면 .copy 방법을 사용합니다. –

+1

질문에 기존 코드를 추가하십시오. –

답변

4

tabl (i) 변수 란 무엇입니까 ?? 또한 워크 시트 데이터를 캡처하고 다른 통합 문서로 복사하기 위해 배열을 구현하는 경우 코드가 훨씬 빠르게 실행됩니다. 복사 할 새 통합 문서에 대한 참조를 보유하고 새 워크 시트에 새 책을 추가하는 변수를 만듭니다. 복사 한 각 시트에 대해 새 워크 시트를 새 책에 추가하고 이름 속성 등을 설정 한 다음 배열 변수에 기존 시트 데이터를 추가하고 (.Value2 속성을 사용하면 빠름) 새 시트에 복사합니다. .. 다음 사용 소스 워크 시트의 원래 서식을 유지하기 위해

Dim x() 
Dim WB As Workbook, WB2 As Workbook 
Dim newWS As Worksheet, WS As Worksheet 
Dim i As Long, r As Long, c As Long 
i = 1 

For Each WS In WB2.Worksheets 
     If Dico_Export.Exists(WS.Name) Then 
      If WS.Name <> "Limites LPG" Then 
       x = WS.Range("A1:N5000").Value2 ''need to adjust range to copy 
       Set newWS = WB.Worksheets.Add(After:=WB.Sheets(1 & i)) ''adjust to suit   your  situation 
       With newWS 
        .Name = "" '' name the worksheet in the new book 
        For r = LBound(x, 1) To UBound(x, 1) 
        For c = LBound(x, 2) To UBound(x, 2) 
         .Cells(r, c) = x(r, c) 
        Next 
        Next 
       End With 
       Erase x 
       Set newWS = Nothing 
      '' tabl(i) = WS.Name (??) 
      End If 
     End If 
Next 
+0

value2로 가져와야합니다. 오타? –

+0

Rub-time 오류 '1004'행의 응용 프로그램 정의 또는 개체 정의 오류 : .cells = x –

+0

값 2는 입력 오류가 아니며 셀 값을 얻는 데 약간 더 빠른 경로입니다. – Marshall

0

:

For r = LBound(x, 1) To UBound(x, 1) 
    For c = LBound(x, 2) To UBound(x, 2) 
    NewWS.Rows(r).RowHeight = WS.Cells(r, c).RowHeight 
    NewWS.Columns(c).ColumnWidth = WS.Cells(r, c).ColumnWidth 
    With NewWS.Cells(r, c) 
     .Font.Bold = WS.Cells(r, c).Font.Bold 
     .Borders(xlEdgeBottom).LineStyle = WS.Cells(r, c).Borders(xlEdgeBottom).LineStyle 
     .Borders(xlEdgeLeft).LineStyle = WS.Cells(r, c).Borders(xlEdgeLeft).LineStyle 
     .Borders(xlEdgeRight).LineStyle = WS.Cells(r, c).Borders(xlEdgeRight).LineStyle 
     .Interior.ColorIndex = WS.Cells(r, c).Interior.ColorIndex 
     .Orientation = WS.Cells(r, c).Orientation 
     .Font.Size = WS.Cells(r, c).Font.Size 
     .HorizontalAlignment = WS.Cells(r, c).HorizontalAlignment 
     .VerticalAlignment = WS.Cells(r, c).VerticalAlignment 
     .MergeCells = WS.Cells(r, c).MergeCells 
     .Font.FontStyle = WS.Cells(r, c).Font.FontStyle 
     .Font.Name = WS.Cells(r, c).Font.Name 
     .ShrinkToFit = WS.Cells(r, c).ShrinkToFit 
     .NumberFormat = WS.Cells(r, c).NumberFormat 
    End With 
    Next 
Next 

이 형식의 대부분을 해결하는 것; 필요에 따라 추가 셀 특성을 추가하십시오.

관련 문제