0

2 つのタブがあるシートがあります。

タブ1では、列J、Kに連続したデータブロックがあり、行数は異なりますが、常にJ1、K1から始まります。

タブ2には、A1から始まる列Aのみにデータがあります。

タブ 1 のデータ ブロック全体を動的に選択できるようにするコードを探していますが、行数が多くてもかまいません。

次に、そのブロックを、タブ 2 の列 A の最初の空のセルから貼り付けます。

これはこれまでの私の試みです:

Sub put_there2()
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim LastRowNumber As Long
Dim LastCell As Range
Dim WS As Worksheet

Set r1 = Range("A2:A100") 'Paste Location

Set WS = Worksheets("Sheet1")
With WS                                                 ' sheet in which to measure range of data to be pasted
    Set LastCell = .Cells(.Rows.Count, 10).End(xlUp)
    LastRowNumber = LastCell.Row


End With

Set r2 = Range(Cells(2, 10), Cells(LastRowNumber, 11))       'region to be copied

For Each r3 In r1
    If r3.Value = "" Then
        r2.Copy r3
        Exit Sub
    End If
Next


End Sub

あなたの考えは高く評価され、

よろしくお願いします

4

3 に答える 3

0

より短い答えは

Set ws = Sheets("Sheet1")
ws.Range(ws.Range("J1:K1"), ws.Range("J1:K1").End(xlDown)).Copy
Sheets("Sheet2").Range("A1").End(xlDown).Offset(1,0).Paste

K も A に移動する必要がある場合、コードは次のようになります。

Set ws = Sheets("Sheet1")

ws.Range(ws.Range("J1"), ws.Range("J1").End(xlDown)).Copy
Sheets("Sheet2").Range("A1").End(xlDown).Offset(1,0).Paste

ws.Range(ws.Range("K1"), ws.Range("K1").End(xlDown)).Copy
Sheets("Sheet2").Range("A1").End(xlDown).Offset(1,0).Paste
于 2013-04-24T17:46:15.303 に答える
0

これは私が必要としていたコードでした

Sub test()
    Application.ScreenUpdating = False

    Dim s1 As Excel.Worksheet
    Dim s2 As Excel.Worksheet
    Dim iLastCellS2 As Excel.Range
    Dim iLastRowS1 As Long

    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")

    ' get last row number of J in Sheet1
    iLastRowS1 = s1.Cells(s1.Rows.Count, "J").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

    'copy&paste into sheet2
    s1.Range("J1", s1.Cells(iLastRowS1, "K")).Copy iLastCellS2

    Application.ScreenUpdating = True
End Sub
于 2013-04-24T18:11:54.590 に答える
0

Range() オブジェクトを使用する場合、暗黙的に ActiveSheet を参照していることに注意してください。ActiveSheet は、あなたが思っているシートではない可能性があります。参照する必要があるシートを明示的に呼び出すことが常に最善です。

これを試して:

Sub test()
    Application.ScreenUpdating = False

    Dim s1 As Excel.Worksheet
    Dim s2 As Excel.Worksheet
    Dim iLastCellS2 As Excel.Range
    Dim iLastRowS1 As Long

    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")

    ' get last row of J in Sheet1
    iLastRowS1 = s1.Cells(s1.Rows.Count, "J").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

    'copy into sheet2
    s1.Range("J1", s1.Cells(iLastRowS1, "J")).Copy iLastCellS2

    ' get last row of K and copy
    iLastRowS1 = s1.Cells(s1.Rows.Count, "K").End(xlUp).Row
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

    s1.Range("K1", s1.Cells(iLastRowS1, "K")).Copy iLastCellS2

    Application.ScreenUpdating = True
End Sub
于 2013-04-24T17:39:03.417 に答える