将数据从一个工作簿复制到另一个工作簿

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