將數據從一個工作簿複製到另一個工作簿

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

你不需要選擇任何東西或使用With語句 - 這是否工作？

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 

---

編輯：好的，讓我們採取不同的方法，我們將定義2分範圍內的對象和轉讓價值編程而不是使用複製/粘貼：

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