| |
3つのworkbookは、すべて開いているもの
また、AAA.xls、BBBxlsのL列に重複がないものとして、
AAA.xls、BBBxls それぞれのL列を見ていって、""でなければ、
その行をコピーして新規ブックに貼り付ける。
（配列に入れて一気にはき出した方が速いと思います。）
最後に並べ替えをする。
新規ブックに
Sub test()
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim NWB As Workbook
Dim r As Range
Set WB1 = Workbooks("AAA.xls")
Set WB2 = Workbooks("BBB.xls")
Set NWB = ThisWorkbook
Application.ScreenUpdating = False
With NWB.Sheets("Sheet1")
.Cells.Clear
.Range("A1:L1").Value = WB1.Sheets("Sheet1").Range("A1:L1").Value
End With
With WB1.Sheets("Sheet1")
For Each r In .Range(.Cells(2, "L"), .Cells(.Rows.Count, "L").End(xlUp))
If r <> "" Then
r.Offset(, -11).Resize(, 12).Copy NWB.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End With
With WB2.Sheets("Sheet1")
For Each r In .Range(.Cells(2, "L"), .Cells(.Rows.Count, "L").End(xlUp))
If r <> "" Then
r.Offset(, -11).Resize(, 12).Copy NWB.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End With
With NWB
.Sheets("Sheet1").Range("A1").CurrentRegion.Sort Key1:=.Sheets("Sheet1").Range("A2"), _
Order1:=xlAscending, Header:=xlGuess
End With
Application.ScreenUpdating = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
