我浏览了这个网站并得到了类似的代码。
我的问题是代码打开文件但不粘贴数据。
我试图粘贴数据的工作簿是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
答案 0 :(得分:2)
您无需选择任何内容或使用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