|
1行目にタイトルか空白行を挿入してください。データ部は2行目から
因みにSheet2には、B列2行目から書込んでいます。
Sub Macro1()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")
lastR = Sh1.Range("A65536").End(xlUp).Row
For i = 2 To lastR
ShMc = Application.Match(Sh1.Cells(i, 1).Value, Sh2.Columns(2), 0)
If IsError(ShMc) = True Then
Sbst = Sh1.Cells(i, 1).Value
Sh2ER = Sh2.Range("B65536").End(xlUp).Row
Sh1.Range("A1:A" & lastR).AutoFilter Field:=1, Criteria1:=Sbst
Sh2.Cells(Sh2ER + 1, 2).Value = Sbst
For ii = 2 To 30 '←Sheet1が30列って事で、まんま30のしました。
'使用状況にあった方法で、調べた方が良いかも。
Sh2EC = Sh2.Cells(Sh2ER + 1, 256).End(xlToLeft).Column
Sh1.Range(Sh1.Cells(2, ii), Sh1.Cells(lastR, ii)).Copy
Sh2.Cells(Sh2ER + 1, Sh2EC + 1).PasteSpecial Paste:=xlValues, Transpose:=True
Next
Sh1.AutoFilterMode = False
End If
Next
Set Sh1 = Nothing
Set Sh2 = Nothing
End Sub
|
|