2012-09-03 3 views
0

하나의 닫힌 Excel 파일에서 현재 열려있는 Excel 파일로 전체 워크 시트를 복사하고 싶지만 파일의 행 크기가 다양하기 때문에 범위를 사용하지 않으려합니다.한 Excel에서 다른 Excel로 전체 워크 시트 복사

나는 범위 내에서 데이터를 rereive을 사용하고 코드는

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _ 
    SourceRange As String, TargetRange As Range, Header As Boolean,   
UseHeaderRow As Boolean) 
' 30-Dec-2007, working in Excel 2000-2007 
Dim rsCon As Object 
Dim rsData As Object 
Dim szConnect As String 
Dim szSQL As String 
Dim lCount As Long 

' Create the connection string. 
If Header = False Then 
    If Val(Application.Version) < 12 Then 
     szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
        "Data Source=" & SourceFile & ";" & _ 
        "Extended Properties=""Excel 8.0;HDR=No"";" 
    Else 
     szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ 
        "Data Source=" & SourceFile & ";" & _ 
        "Extended Properties=""Excel 12.0;HDR=No"";" 
    End If 
Else 
    If Val(Application.Version) < 12 Then 
     szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
        "Data Source=" & SourceFile & ";" & _ 
        "Extended Properties=""Excel 8.0;HDR=Yes"";" 
    Else 
     szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ 
        "Data Source=" & SourceFile & ";" & _ 
        "Extended Properties=""Excel 12.0;HDR=Yes"";" 
    End If 
End If 

If SourceSheet = "" Then 
    ' workbook level name 
    szSQL = "SELECT * FROM " & SourceRange$ & ";" 
Else 
    ' worksheet level name or range 
    szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];" 
End If 

On Error GoTo SomethingWrong 

Set rsCon = CreateObject("ADODB.Connection") 
Set rsData = CreateObject("ADODB.Recordset") 

rsCon.Open szConnect 
rsData.Open szSQL, rsCon, 0, 1, 1 

' Check to make sure we received data and copy the data 
If Not rsData.EOF Then 

    If Header = False Then 
     TargetRange.Cells(1, 1).CopyFromRecordset rsData 
    Else 
     'Add the header cell in each column if the last argument is True 
     If UseHeaderRow Then 
      For lCount = 0 To rsData.Fields.Count - 1 
       TargetRange.Cells(1, 1 + lCount).Value = _ 
       rsData.Fields(lCount).Name 
      Next lCount 
      TargetRange.Cells(2, 1).CopyFromRecordset rsData 
     Else 
      TargetRange.Cells(1, 1).CopyFromRecordset rsData 
     End If 
    End If 

Else 
    MsgBox "No records returned from : " & SourceFile, vbCritical 
End If 

' Clean up our Recordset object. 
rsData.Close 
Set rsData = Nothing 
rsCon.Close 
Set rsCon = Nothing 
Exit Sub 

SomethingWrong: 
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _ 
     vbExclamation, "Error" 
On Error GoTo 0 

End Sub 

전체 워크 시트 및 모든 행을 가져 오기에 어떤 도움이됩니다/열은 좋은 것입니다.

감사합니다.

답변

0

왜 이렇게하지 않습니까? 당신이 가장 잘 맞는 중 통합 문서 .Sheets(2), 자신의 이름 .Sheets("MySheet")에 의해 또는 번호로 시트를 호출 할 수 있습니다

Dim wbkSource As Workbook 
Set wbkSource = Workbooks.Open("C:\BookFromWhichToCopy.xlsx") 
wbkSource.Sheets("MySheet").Copy Before:=ThisWorkbook.Sheets(2) 
wbkSource.Close 

참고.

+0

작동하지 않습니다. 워크 시트가 너무 커서 복사하여 붙여 넣어야합니다. 나는이 파일을로드 할 때마다 내가 지금부터 복사하고있는 파일을 열 때마다 성가신 일을 할 수있게되었습니다. 아마도 파일이 로컬에 저장되지 않기 때문에 발생합니다. – EmberZ

+0

나는 꽤 따르지 않는다 ... 그것이 효과가 있느냐 없느냐? 작동 시키려면 무엇을 추가 했습니까? 네, 그러면 통합 문서가 열립니다. 그러나 * 파일을 읽으려는 * 어떤 일이든간에 통합 문서 파일을 열 것입니다. –

관련 문제