0

私はこのウェブサイトを調べて、これに似たコードを入手しました。私の問題は、コードがファイルを開いているが、データを貼り付けていないことです。データを貼り付けようとしているワークブックはTRY5.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
4

1 に答える 1

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

編集：OK、別のアプローチを取りましょう。コピー/貼り付けを使用するのではなく、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
于 2013-01-31T11:22:20.387 に答える