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

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

그래서 보통 제가 하고 싶은 일은 워크북을 복사하는 것입니다.다만, 소스 워크북이 매크로를 실행하고 있기 때문에, 매크로를 사용하지 않고, 같은 카피를 작성합니다.VBA로 간단하게 할 수 있는 방법이 있다고 생각합니다만, 아직 찾지 못했습니다.새로운 워크북에 시트를 1장씩 카피하는 것을 검토하고 있습니다.이거 어떻게 해요?더 좋은 방법이 있을까요?

Keytarhero의 답변을 조금 다시 쓰고 싶습니다.

Sub CopyWorkbook()

Dim sh as Worksheet,  wb as workbook

Set wb = workbooks("Target workbook")
For Each sh in workbooks("source workbook").Worksheets
   sh.Copy After:=wb.Sheets(wb.sheets.count) 
Next sh

End Sub

---

편집: 시트 이름 배열을 작성하여 한 번에 복사할 수도 있습니다.

Workbooks("source workbook").Worksheets(Array("sheet1","sheet2")).Copy _
         After:=wb.Sheets(wb.sheets.count)

주의: XLS에서 XLS로 시트를 복사하면 오류가 발생합니다.반대로 올바르게 동작한다(XLS에서 XLSX로).

Ozgrid에 있는 누군가가 비슷한 질문에 대답했습니다.기본적으로 워크북1에서 워크북2로 각 시트를 한 번에 하나씩 복사하기만 하면 됩니다.

Sub CopyWorkbook()

    Dim currentSheet as Worksheet
    Dim sheetIndex as Integer
    sheetIndex = 1

    For Each currentSheet in Worksheets

        Windows("SOURCE WORKBOOK").Activate 
        currentSheet.Select
        currentSheet.Copy Before:=Workbooks("TARGET WORKBOOK").Sheets(sheetIndex) 

        sheetIndex = sheetIndex + 1

    Next currentSheet

End Sub

면책사항:저는 이 코드를 시험해 보지 않고 대신 당신의 문제에 링크된 예를 채택했습니다.그 외에는 아무것도 없다면, 의도한 해결책으로 이어질 것입니다.

xlsx로 저장할 수 있습니다.그 후 매크로를 해방하여 작업량이 적은 새 워크북을 생성합니다.

ThisWorkbook.saveas Filename:=NewFileNameWithPath, Format:=xlOpenXMLWorkbook

vba 앱이 실행 중인 워크북의 모든 시트를 앱 매크로가 없는 새로운 워크북에 복사할 수 있었습니다.

ActiveWorkbook.Sheets.Copy

모든 매크로가 모듈에 있다고 가정하면 이 링크가 도움이 될 수 있습니다.워크북을 복사한 후 각 모듈을 반복하여 삭제하십시오.

대신 이거 먹어봐.

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    ws.Copy
Next

간단하게 쓸 수 있습니다.

Worksheets.Copy

사이클을 하는 대신에.기본적으로 워크시트 컬렉션은 새 워크북에 재생성됩니다.

2010년판 XL에서 동작하는 것이 실증되었습니다.

    Workbooks.Open Filename:="Path(Ex: C:\Reports\ClientWiseReport.xls)"ReadOnly:=True


    For Each Sheet In ActiveWorkbook.Sheets

        Sheet.Copy After:=ThisWorkbook.Sheets(1)

    Next Sheet

Windows FileDialog(msoFileDialogFilePicker)를 사용하여 데스크톱에서 닫힌 워크북을 찾은 후 모든 워크시트를 열린 워크북에 복사합니다.

Sub CopyWorkBookFullv2()
Application.ScreenUpdating = False

Dim ws As Worksheet
Dim x As Integer
Dim closedBook As Workbook
Dim cell As Range
Dim numSheets As Integer
Dim LString As String
Dim LArray() As String
Dim dashpos As Long
Dim FileName As String

numSheets = 0

For Each ws In Application.ActiveWorkbook.Worksheets
    If ws.Name <> "Sheet1" Then
       Sheets.Add.Name = "Sheet1"
   End If
Next

Dim fileExplorer As FileDialog
Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)
Dim MyString As String

fileExplorer.AllowMultiSelect = False

  With fileExplorer
     If .Show = -1 Then 'Any file is selected
     MyString = .SelectedItems.Item(1)

     Else ' else dialog is cancelled
        MsgBox "You have cancelled the dialogue"
        [filePath] = "" ' when cancelled set blank as file path.
        End If
    End With

    LString = Range("A1").Value
    dashpos = InStr(1, LString, "\") + 1
    LArray = Split(LString, "\")
    'MsgBox LArray(dashpos - 1)
    FileName = LArray(dashpos)

strFileName = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & FileName

Set closedBook = Workbooks.Open(strFileName)
closedBook.Application.ScreenUpdating = False
numSheets = closedBook.Sheets.Count

        For x = 1 To numSheets
            closedBook.Sheets(x).Copy After:=ThisWorkbook.Sheets(1)
        x = x + 1
                 If x = numSheets Then
                    GoTo 1000
                 End If
Next

1000

closedBook.Application.ScreenUpdating = True
closedBook.Close
Application.ScreenUpdating = True

End Sub

이거 드셔보세요.

서브 Get_Data_From_File()

     'Note: In the Regional Project that's coming up we learn how to import data from multiple Excel workbooks
    ' Also see BONUS sub procedure below (Bonus_Get_Data_From_File_InputBox()) that expands on this by inlcuding an input box
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
         'copy data from A1 to E20 from first sheet
        OpenBook.Sheets(1).Range("A1:E20").Copy
        ThisWorkbook.Worksheets("SelectFile").Range("A10").PasteSpecial xlPasteValues
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
End Sub

또는 다음과 같습니다.

Get_Data_From_File_InputBox()

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim ShName As String
Dim Sh As Worksheet
On Error GoTo Handle:

FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*.xls*")
Application.ScreenUpdating = False
Application.DisplayAlerts = False

If FileToOpen <> False Then
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
    ShName = Application.InputBox("Enter the sheet name to copy", "Enter the sheet name to copy")
    For Each Sh In OpenBook.Worksheets
        If UCase(Sh.Name) Like "*" & UCase(ShName) & "*" Then
            ShName = Sh.Name
        End If
    Next Sh

    'copy data from the specified sheet to this workbook - updae range as you see fit
    OpenBook.Sheets(ShName).Range("A1:CF1100").Copy
    ThisWorkbook.ActiveSheet.Range("A10").PasteSpecial xlPasteValues
    OpenBook.Close False
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

핸들: 에러인 경우.번호 = 9 그러면 MsgBox "시트 이름이 존재하지 않습니다.철자를 확인하세요." 그렇지 않으면 메시지 상자 "오류가 발생했습니다."OpenBook 종료.False Application을 닫습니다.ScreenUpdating = True Application.DisplayAlerts = True End 하위

둘 다로서 일하다

언급URL : https://stackoverflow.com/questions/6863940/how-to-copy-sheets-to-another-workbook-using-vba