Excelで片方の列からもう1つの列へﾃﾞｰﾀを貼り付けていきたい今､AI列に4行目から6000行ぐらいﾃﾞｰﾀが入っております｡そしてAJ列には､4行目から15万行まで､同じく60…

Excelで片方の列からもう1つの列へﾃﾞｰﾀを貼り付けていきたい

今､AI列に4行目から6000行ぐらいﾃﾞｰﾀが入っております｡
そしてAJ列には､4行目から15万行まで､同じく6000行ほどﾃﾞｰﾀが入っております｡

AI列の方は､4行目から6000行目ほどまで､びっしり密にﾃﾞｰﾀが入っていますが｡
AJ列の方は､空白ｾﾙの行が多く､まばらにﾃﾞｰﾀが入っています｡

この状態におきまして｡
AI列のﾃﾞｰﾀを4行目から1つずつ､空白ｾﾙを無視しながら､AJ列のｾﾙへ上から(4行目から)上書きしたいのです｡

AJ列のｾﾙのﾃﾞｰﾀの個数､AI列のｾﾙのﾃﾞｰﾀの個数も､ほぼ同じなので｡
うまくAJ列のﾃﾞｰﾀをAI列へ､全て上書きできますと助かります｡
AJ列のﾃﾞｰﾀは無くなっても構いません｡

よろしくお願い致します｡

次の手順でいかがでしょうか｡

1)作業用として､AJ列の右に1列挿入してください｡ここがAK列になります｡

2)ｾﾙ[AK4]に次の式を入れます｡
=IF(AJ4<>"",INDEX(AI$4:AI$6000,COUNTA(AJ$4:AJ4),1),"")

3)ｾﾙ[AK4]を選択してｺﾋﾟｰし､AK5?AK150000まで式として貼り付けてください｡これでAK列の内容が､AJ列に上書きしたいものになるかと思います｡

4)AK列をｺﾋﾟｰして､AJ列へ値として貼り付けてください｡

5)作業用に作ったAK列を削除してください｡

VBAでも良いのであれば､こんな感じでしょうか｡

Public Sub transferAI2AJ()

 Const TARGET_SHEET_NAME As String = "Sheet1"

 'ｺﾋﾟｰ元列(AI)
 Const SOURCE_COL As Long = 35

 'ｺﾋﾟｰ先列(AJ)
 Const DEST_COL As Long = 36

 Const BEGIN_ROW As Long = 4

 Dim lCurrentRowAI As Long
 Dim lCurrentRowAJ As Long
 Dim lBeginRow As Long
 Dim lEndRowAI As Long
 Dim lEndRowAJ As Long
 Dim lTermRowAJ As Long
 Dim lTargetCount As Long

 lCurrentRowAI = BEGIN_ROW
 lCurrentRowAJ = BEGIN_ROW

 With ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
' .EnableCalculation = False

 'AI列の最終行
 lEndRowAI = .Cells(.Rows.Count, SOURCE_COL).End(xlUp).Row

 'AJ列の最終行
 lEndRowAJ = .Cells(.Rows.Count, DEST_COL).End(xlUp).Row

 Do
 If .Cells(lCurrentRowAJ, DEST_COL).Value <> "" Then
 'AJ列にﾃﾞｰﾀが有る
 If .Cells(lCurrentRowAJ + 1, DEST_COL).Value <> "" Then
 '次の行にﾃﾞｰﾀが有れば､連続する終端行を取得
 lTermRowAJ = .Cells(lCurrentRowAJ, DEST_COL).End(xlDown).Row
 Else
 '次の行にﾃﾞｰﾀがなければ､この行が終端行
 lTermRowAJ = lCurrentRowAJ
 End If

 'ｺﾋﾟｰする行数
 lTargetCount = lTermRowAJ - lCurrentRowAJ + 1

 'AI列の最終ﾃﾞｰﾀ行を超える場合､ｺﾋﾟｰする行数と最終行を補正する
 If lCurrentRowAI + lTargetCount - 1 > lEndRowAI Then
 lTargetCount = lEndRowAI - lCurrentRowAI + 1
 lTermRowAJ = lCurrentRowAJ + lTargetCount - 1
 End If

 'AI列からAJ列にｺﾋﾟｰ
 .Range(.Cells(lCurrentRowAI, SOURCE_COL), .Cells(lCurrentRowAI + lTargetCount - 1, SOURCE_COL)).Copy .Cells(lCurrentRowAJ, DEST_COL)

 'AI､AJ各列の次の基準行を設定
 lCurrentRowAI = lCurrentRowAI + lTargetCount
 lCurrentRowAJ = .Cells(lTermRowAJ, DEST_COL).End(xlDown).Row
 Else
 'AJ列にﾃﾞｰﾀがない
 'AJ列の基準行を設定
 lCurrentRowAJ = .Cells(lCurrentRowAJ, DEST_COL).End(xlDown).Row
 End If
 Loop Until (lCurrentRowAJ > lEndRowAJ) Or (lCurrentRowAI > lEndRowAI)

' .EnableCalculation = True
 End With

 Debug.Print "Done."

End Sub

EnableCalculation のｺﾒﾝﾄ化(2箇所)は､必要であれば解除していただければよろしいかと｡