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

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