한 통합 문서의 데이터를 다른 통합 문서로 복사

Question

이 웹 사이트를 살펴본 결과 이와 비슷한 코드가 있습니다. 내 문제는 코드가 파일을 열고 있지만 데이터를 붙여 넣지 않는다는 것입니다. 데이터를 붙여 넣으려고하는 통합 문서는 TRY 5.xlsm이고 붙여 넣을 범위는 B3입니다. BAFD.xlsx의 통합 문서 복사본에서 데이터를 복사하고 범위는 V1:AF1입니다.

Sub CopyData() 

    Dim wb1 As Workbook, wb2 As Workbook 
    Dim ws1 As Worksheet, ws2 As Worksheet 

    Set wb1 = Workbooks.Open("C:\Documents and Settings\43707844\Desktop\Change of weights\Svar\BAFD\Copy of BAFD.xlsx") 
    Set wb2 = Workbooks.Open("C:\Documents and Settings\43707844\Desktop\Change of weights\Svar\BAFD\Practise\TRY 5.xlsm") 

    Set ws1 = wb1.Sheets("Calib_30Nov") 
    Set ws2 = wb2.Sheets("Calib29_30") 

    With ws1.Range("V1:AF1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
    ws2.Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ 
     SkipBlanks:=False, Transpose:=False 


    End With 

End Sub 

Answer 1

아무 것도 선택하거나 사용하지 않아도됩니다. 작동합니까?

Sub CopyData() 

Dim wb1 As Workbook, wb2 As Workbook 
Dim ws1 As Worksheet, ws2 As Worksheet 

Set wb1 = Workbooks.Open("C:\Documents and Settings\43707844\Desktop\Change of weights\Svar\BAFD\Copy of BAFD.xlsx") 
Set wb2 = Workbooks.Open("C:\Documents and Settings\43707844\Desktop\Change of weights\Svar\BAFD\Practise\TRY 5.xlsm") 

Set ws1 = wb1.Sheets("Calib_30Nov") 
Set ws2 = wb2.Sheets("Calib29_30") 

ws1.Range("V1:AF1", ws1.Range("V1:AF1").End(xlDown)).Copy 
ws2.Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ 
    SkipBlanks:=False, Transpose:=False 

End Sub 

---

편집 : OK 우리가이 범위 객체를 정의하고 복사/붙여 넣기를 사용하는 것보다 프로그래밍 방식으로 오히려 값을 전송하는 것,의 다른 방법을 보자 :

Sub CopyData() 

Dim wb1 As Workbook, wb2 As Workbook 
Dim ws1 As Worksheet, ws2 As Worksheet 
Dim rngCopy As Range, rngPaste As Range 

Set wb1 = Workbooks.Open("C:\Documents and Settings\43707844\Desktop\Change of weights\Svar\BAFD\Copy of BAFD.xlsx") 
Set wb2 = Workbooks.Open("C:\Documents and Settings\43707844\Desktop\Change of weights\Svar\BAFD\Practise\TRY 5.xlsm") 

Set ws1 = wb1.Sheets("Calib_30Nov") 
Set ws2 = wb2.Sheets("Calib29_30") 

Set rngCopy = ws1.Range("V1:AF1", ws1.Range("V1:AF1").End(xlDown)) 
Set rngPaste = ws2.Range("B3").Resize(rngCopy.Rows.Count, rngCopy.Columns.Count) 
rngPaste.Value = rngCopy.Value 

End Sub 

---

편집 - 이제 시트를 통과하여 각 페이지에 대해 데이터를 복사해야합니다.

Sub CopyData() 

Dim wb1 As Workbook, wb2 As Workbook 
Dim ws1 As Worksheet, ws2 As Worksheet 
Dim rngCopy As Range, rngPaste As Range 
Dim strWs1 As String, strWs2 As String, i As Integer, arrSheets() As String 
Dim blnExists1 As Boolean, blnExists2 As Boolean 

Set wb1 = Workbooks.Open("C:\Documents and Settings\43707844\Desktop\Change of weights\Svar\BAFD\Copy of BAFD.xlsx") 
Set wb2 = Workbooks.Open("C:\Documents and Settings\43707844\Desktop\Change of weights\Svar\BAFD\Practise\TRY 5.xlsm") 

'Put all BAFD.xlsx worksheet names into a string array so we can check that they exist 
ReDim arrSheets(wb1.Worksheets.Count) 
For i = 1 To wb1.Worksheets.Count 
    arrSheets(i) = wb1.Worksheets(i).Name 
Next 

'Loop through all sheets in TRY 5, identify numbers and transfer data across 
For Each ws2 In wb2.Worksheets 
    Debug.Print "WS2 Name: " & ws2.Name 
    strWs1 = Mid(ws2.Name, 5, 2) 
    strWs2 = Mid(ws2.Name, 8, 2) 
    Debug.Print "WS2 1 Number: " & strWs1 
    Debug.Print "WS2 2 Number: " & strWs2 
    blnExists1 = False 
    blnExists2 = False 
    'Check that sheets exist in BAFD.xlsx 
    For i = LBound(arrSheets) To UBound(arrSheets) 
     If arrSheets(i) = "Calib_" & strWs1 Then blnExists1 = True 
     If arrSheets(i) = "Calib_" & strWs2 Then blnExists2 = True 
    Next 

    Debug.Print "WS1 Exists: " & blnExists1 
    Debug.Print "WS2 Exists: " & blnExists2 

    'If both exist, copy the values across. If they don't, move on to the next one 
    If blnExists1 = True And blnExists2 = True Then 
     'Get first sheet details 
     Set ws1 = wb1.Sheets("Calib_" & strWs1) 
     Set rngCopy = ws1.Range("V1:AF1", ws1.Range("V1:AF1").End(xlDown)) 
     Set rngPaste = ws2.Range("B3").Resize(rngCopy.Rows.Count, rngCopy.Columns.Count) 
     rngPaste.Value = rngCopy.Value 
     'Get second sheet details 
     Set ws1 = wb1.Sheets("Calib_" & strWs2) 
     Set rngCopy = ws1.Range("V1:AF1", ws1.Range("V1:AF1").End(xlDown)) 
     Set rngPaste = ws2.Range("N3").Resize(rngCopy.Rows.Count, rngCopy.Columns.Count) 
     rngPaste.Value = rngCopy.Value 
    End If 
Next 

End Sub