Excel総合相談所 132

**名無しさん＠そうだ選挙にいこう** · 2018/07/01(日) 12:22:32.86

▼━質問テンプレ (出来れば使ってね) ━━━
【1 OSの種類　　　　 .】 Windows**
【2 Excelのバージョン　】 Excel**
【3 VBAが使えるか　　 .】はい･いいえ
【4 VBAでの回答の可否】可･否

▼━関連スレ━━━━━━━━━━━━

前スレ
Excel総合相談所 131
https://find.5ch.net/search?q=excel

Excel VBA 質問スレ Part51(1000到達済み)
https://find.5ch.net/search?q=excel+vba

【質問不可】Excel総合相談所スレの雑談・議論スレ4
https://find.5ch.net/search?q=excel+%E3%80%80%E7%9B%B8%E8%AB%87%E6%89%80

**名無しさん＠そうだ選挙にいこう** · 2018/10/30(火) 17:24:06.12

>>819
Sub 探すで()
Dim Y1 As Long
Dim Y2 As Long
Dim X As Long
Dim r As Range
Const START_ROW As Long = 5
Const COPY_MAX_COL As Long = 20

On Error GoTo eH
Application.ScreenUpdating = False
For Y1 = START_ROW To Sheet1.Cells(START_ROW, 1).End(xlDown).Row '、空白でストップ
Set r = Sheet2.Columns(1).Find(Sheet1.Cells(Y1, 1).Value, , , xlWhole) 'A列で探す
If Not (r Is Nothing) Then
Y2 = r.Row
Sheet2.Range(Sheet2.Cells(Y2, 2), Sheet2.Cells(Y2, COPY_MAX_COL)).Copy
Sheet1.Cells(Y1, 2).PasteSpecial xlPasteValues
End If
Next Y1
eH:
Application.ScreenUpdating = True
End Sub

**名無しさん＠そうだ選挙にいこう** · 2018/10/30(火) 17:25:34.79

sheet2 = Sheet1(1)　で。
あ、不細工やらかしてるけど、動く動く。