vba를 사용하여 단일 워크시트만 다른 워크북에 복사하는 방법

vba를 사용하여 단일 워크시트만 다른 워크북에 복사하는 방법

1개 있습니다.WorkBook("SOURCE")약 20장이 들어 있습니다.
한 장의 특정 시트만 다른 시트에 복사하고 싶습니다.Workbook("TARGET")Excel VBA를 사용합니다.

"TARGET" 워크북이 아직 존재하지 않습니다.런타임에 생성해야 합니다.

사용 방법 -

1)Activeworkbook.SaveAs<--- 작동하지 않습니다.이렇게 하면 모든 시트가 복사됩니다.저는 특정 시트만 원합니다.

저는 약 20장이 포함된 워크북("소스") 1권을 가지고 있습니다.Excel VBA를 사용하여 특정 시트 하나만 다른 워크북("TARGET")에 복사하고 싶습니다."TARGET" 워크북이 아직 존재하지 않습니다.런타임에 생성해야 합니다.

어나더 웨이

Sub Sample()
    '~~> Change Sheet1 to the relevant sheet
    '~~> This will create a new workbook with the relevant sheet
    ThisWorkbook.Sheets("Sheet1").Copy

    '~~> Save the new workbook
    ActiveWorkbook.SaveAs "C:\Target.xlsx", FileFormat:=51
End Sub

그러면 대상이라는 새 워크북이 자동으로 만들어집니다.관련 시트가 있는 xlsx

TARGET이라는 워크북에 시트를 복사하는 방법

Sheets("xyz").Copy After:=Workbooks("TARGET.xlsx").Sheets("abc")

이렇게 하면 복사된 시트 xyz가 시트 다음에 TARGET 워크북에 들어갑니다. abc 분명히 시트 앞에 시트를 놓으려면 코드의 Before for After를 교체하십시오.

TARGET이라는 워크북을 만들려면 먼저 새 워크북을 추가한 다음 저장하여 파일 이름을 정의해야 합니다.

Application.Workbooks.Add (xlWBATWorksheet)
ActiveWorkbook.SaveAs ("TARGET")

그러나 워크북을 기본 위치에 저장하기 때문에 적합하지 않을 수 있습니다.내 문서.

하지만 이것이 당신에게 무언가를 줄 수 있기를 바랍니다.

이 VBA 프로그램을 사용해 볼 수 있습니다.

Option Explicit 

Sub CopyWorksheetsFomTemplate() 
    Dim NewName As String 
    Dim nm As Name 
    Dim ws As Worksheet 

    If MsgBox("Copy specific sheets to a new workbook" & vbCr & _ 
    "New sheets will be pasted as values, named ranges removed" _ 
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub 

    With Application 
        .ScreenUpdating = False 

         '       Copy specific sheets
         '       *SET THE SHEET NAMES TO COPY BELOW*
         '       Array("Sheet Name", "Another sheet name", "And Another"))
         '       Sheet names go inside quotes, seperated by commas
        On Error GoTo ErrCatcher 
        Sheets(Array("Sheet1", "Sheet2")).Copy 
        On Error GoTo 0 

         '       Paste sheets as values
         '       Remove External Links, Hperlinks and hard-code formulas
         '       Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets 
            ws.Cells.Copy 
            ws.[A1].PasteSpecial Paste:=xlValues 
            ws.Cells.Hyperlinks.Delete 
            Application.CutCopyMode = False 
            Cells(1, 1).Select 
            ws.Activate 
        Next ws 
        Cells(1, 1).Select 

         '       Remove named ranges
        For Each nm In ActiveWorkbook.Names 
            nm.Delete 
        Next nm 

         '       Input box to name new file
        NewName = InputBox("Please Specify the name of your new workbook", "New Copy") 

         '       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls" 
        ActiveWorkbook.Close SaveChanges:=False 

        .ScreenUpdating = True 
    End With 
    Exit Sub 

ErrCatcher: 
    MsgBox "Specified sheets do not exist within this workbook" 

End Sub 

아래의 훨씬 긴 예제는 위의 유용한 스니펫 중 일부를 결합한 것입니다.

• 복사할 시트 수를 지정할 수 있습니다.
• 탭을 끌어서 이동하는 것과 같이 전체 시트를 복사하거나 셀 내용을 값으로만 복사할 수 있지만 형식은 유지할 수 있습니다.

개선(오류 처리 개선, 일반 정리)을 위해 여전히 많은 작업을 수행할 수 있지만, 좋은 시작을 제공할 수 있기를 바랍니다.

새 시트는 자체 테마의 글꼴과 색상을 사용하기 때문에 모든 형식이 사용되는 것은 아닙니다.값으로만 붙여넣을 때 복사하는 방법을 알 수 없습니다.

옵션 명시적
데이터를 새 파일로 하위 복사()어플.화면 업데이트 = 거짓
다양한 데이터 복사 방법 허용:
sheet = 전체 sheet 복사가치관Formating =을 사용하여 다음과 같은 이름의 새 시트를 만듭니다.원본, 셀에서만 값을 복사한 다음원래 서식을 적용합니다.형식 지정은 다음과 같습니다.붙여넣기 특수 > 형식 명령 - 테마만큼 좋습니다.색상 및 글꼴은 보존되지 않습니다.
복사 방법을 문자열로 표시copyMethod = "값"포맷 포함"
새 파일의 새 파일 이름을 문자열 '이름(+선택적 경로)으로 어둡게 지정희미한 테마TempFilePath As String ' 소스 파일의 테마를 임시로 저장하려면
Dim source Workbook을 워크북으로 '이 파일소스 워크북 설정 = 이 워크북
새 워크북을 워크북의 새 파일로 어둡게 설정
워크시트로 어둡게 '나중에 시트를 반복합니다.
조광 시트 이름 문자열로 '시트 이름을 저장하려면Dim sheetCount As Long' 여러 번 카운트하지 않도록 하려면
내부 코드 이름을 보다 신뢰할 수 있도록 사용하여 복사할 시트.
새 컬렉션으로 복사할 DimcolSheet 개체colSheetObjectsToCopy.시트 1 추가colSheetObjectsToCopy.시트 2 추가
사용자로부터 새 파일의 파일 이름을 가져옵니다.
도newFilename = InputBox("새 워크북의 이름을 지정하십시오.") & vbCr & vbCr & "전체 경로를 입력하거나 파일 이름만 입력하면 파일이 동일한 위치(" & sourceWorkbook")에 저장됩니다.경로 & ").이미 열려 있는 워크북의 이름을 사용하지 마십시오. 그렇지 않으면 이 스크립트가 손상됩니다.", "새 복사본")newFilename = " " 그 다음 MsgBox "무엇인가를 입력해야 합니다.", vbExclamation, "파일 이름이 필요합니다."새 파일 이름이 나올 때까지 반복 > " "
경로를 제공하지 않은 경우 원본 워크북과 동일한 위치를 가정합니다.
완벽하지 않음 - 경로 구분 기호가 있는 경우 경로가 제공되었다고 가정합니다.어딘가에 존재합니다.여전히 잘못된 경로일 수 있습니다.검사가 수행되지 않습니다.경로가 실제로 존재하는지 확인합니다.
InStr(1, 새 파일 이름, 응용 프로그램)인 경우.경로 구분 기호, vbTextCompare) = 0인 경우newFilename = sourceWorkbook.경로 및 응용 프로그램.경로 구분 기호 & 새 파일 이름종료할 경우
새 워크북을 만들고 사용자가 요청한 대로 저장합니다.
NB 파일 이름이 다음과 같은 워크북일 경우 실패합니다.이미 열려 있습니다. 확인해야 합니다.
새 Workbook = Application을 설정합니다.문제집.추가(xlWBAT 워크시트)새 워크북.파일 이름으로 저장:= newFilename, _파일 형식:=xl워크북 기본값
테마 글꼴과 색상은 대부분의 붙여넣기 작업에서 복사되지 않습니다.
그러면 원본 워크북의 테마가 저장된 다음 새 워크북에 로드됩니다.
버그:안 돼요!'어쨌든'TempFilePath = 환경("temp") 및 응용 프로그램.경로 구분 기호 및 원본 워크북.이름 & " - Theme.xml"'출처 워크북'입니다.테마. 테마폰트 스킴.테마 저장TempFilePath'출처 워크북'입니다.테마. 테마 색상표.테마 저장TempFilePath'새 워크북'입니다.테마. 테마폰트 스킴.테마 로드TempFilePath'새 워크북'입니다.테마. 테마 색상표.테마 로드TempFilePath'오류 발생 시 다음에 다시 시작킬 테마TempFilePath ' kill = VBA-speak에서 삭제'오류 시 0으로 이동

getWorksheetNameFromObject는 워크시트 개체가 그렇지 않으면 null을 반환합니다.존재하는복사할 각 sht IncolSheet 개체에 대해sheetFriendlyName = 객체에서 워크시트Name 가져오기(source Workbook, sht)어플.상태 표시줄 = "VBL 복사" & 시트 이름Null이 아닌 경우(시트 친화적 이름)그리고나서Case copyMethod 선택대소문자 "시트"원본 워크북.시트(시트 이름).복사 _이후:=새 워크북.시트(새 워크북).시트 수)대소문자 "값"포맷 포함"새 워크북.Sheets.Add After:=새 워크북.시트(새 워크북).시트 수), _유형:=sourceWorkbook.시트(시트 이름).유형sheetCount = 새 워크북.시트 수새 워크북.시트(시트 개수).이름 = 시트 이름현재 원본 시트의 모든 셀을 클립보드에 복사합니다.바로 복사할 수 있음대상 매개 변수를 지정하여 새 워크북으로 이동하지만 이 경우붙여넣기 특수를 값으로만 수행하려고 하는데 복사 방법에서는 이를 허용하지 않습니다.
원본 워크북.시트(시트 이름).Cells.Copy' 대상:= 새 워크북.시트(새 워크북).시트, 개수).[A1]새 워크북.시트(시트 개수).[A1]특수 붙여넣기:=304개 값새 워크북.시트(시트 개수).[A1]특수 붙여넣기:=xl형식새 워크북.시트(시트 개수).탭.색상 = 원본 워크북.시트(시트 이름).탭.색상어플.CutCopyMode = 거짓선택 종료종료할 경우다음 sht
어플.상태 표시줄 = 거짓어플.화면 업데이트 = 참활성 워크북입니다.절약하다

Sub ActiveSheet_toDESKTOP_As_Workbook()

Dim Oldname As String
Dim MyRange As Range
Dim MyWS As String

MyWS = ActiveCell.Parent.Name

    Application.DisplayAlerts = False 'hide confirmation from user
    Application.ScreenUpdating = False
    Oldname = ActiveSheet.Name
    'Sheets.Add(Before:=Sheets(1)).Name = "FirstSheet"
    
    'Get path for desktop of user PC
    Path = Environ("USERPROFILE") & "\Desktop"
    

    ActiveSheet.Cells.Copy
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "TransferSheet"
    ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveSheet.Cells.Copy
    
    'Create new workbook and past copied data in new workbook & save to desktop
    Workbooks.Add (xlWBATWorksheet)
    ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveSheet.Cells(1, 1).Select
    ActiveWorkbook.ActiveSheet.Name = Oldname    '"report"
    ActiveWorkbook.SaveAs Filename:=Path & "\" & Oldname & " WS " & Format(CStr(Now()), "dd-mmm (hh.mm.ss AM/PM)") & ".xlsx"
    ActiveWorkbook.Close SaveChanges:=True

    
    Sheets("TransferSheet").Delete
    
    
   Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Worksheets(MyWS).Activate
    'MsgBox "Exported to Desktop"

End Sub

언급URL : https://stackoverflow.com/questions/20246465/how-to-copy-only-a-single-worksheet-to-another-workbook-using-vba