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

我已经浏览了这个网站，并得到了类似这样的代码。 我的问题是，代码是打开文件，但不粘贴的数据。 我试图粘贴数据的工作簿是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

你不需要select任何东西或使用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