こういう単純なマクロの質問って、結構落とし穴が一杯がありますね。 空白と言いながら、この前の人のように空白値にスペースが入っていることで、本当にブランクセルではないケースがあります。それで、こちらに文句を付けられてしまいました。ダメだったら、無視してくれればよいです。 >※G列以降にもデータが入力されていますが、処理したい列範囲はA列～F列です。 これは、F列までで、それ以降は、詰めたくないというケースですね。 それを読み取らないといけないようです。(マクロよりも、質問を読み取るほうが、何倍も難しいです。） そうすると、1,2は、両方ともダメだということになります。それで考えたのは、3番目のコードです。(1,2は今回は取りやめ）Delete は、セル一つずつ削除せずに、Union などで、まとめて削除するというのが定石です。 以下は、配列を使っています。 処理後のイメージで、 2行目　***　　***　　　 -　　　　***　　 ***　　　- なぜ、空白値が間に残っているか分かりません。もしかしたら、3行目からかな？ もしそうだったら、 　　Set rng = .Offset(2).Resize(.Rows.Count - 2, iCL) 'F列まで となります。 '// Sub Test3() 　Dim rng As Range 　Dim i As Long, j As Long 　Dim ar As Variant 　Dim arBuf() As String 　Dim cl As Variant 　Dim delRng As Range 　Const iCL As Long = 6 '列 　With ActiveSheet.UsedRange 　　Set rng = .Offset(1).Resize(.Rows.Count - 1, iCL) 'F列まで 　　ReDim arBuf(0, iCL - 1) 　　For Each cl In rng.Rows 　　　ar = Application.Index(cl.Value, 1, 0)　'配列に格納 　　　For i = 1 To UBound(ar) 　　　　If Trim(ar(i)) <> "" Then 　　　　　arBuf(0, j) = ar(i) 　　　　　j = j + 1 　　　　End If 　　　Next 　　　cl.Cells = arBuf 　　　ReDim arBuf(0, iCL - 1) 　　　j = 0 　　Next 　End With End Sub

こんにちは！ 一例です。 Sub test() Dim i, j As Long For i = 2 To ActiveSheet.UsedRange.Rows.Count For j = 6 To 1 Step -1 If Cells(i, j) = "" Then Cells(i, j).Delete (xlToLeft) End If Next j Next i End Sub こんな感じですかね？ 参考になれば良いのですが・・・m(__)m

例示のデータの2行目が良くわからないのですが、単純に空白セルを左側に詰めるなら以下のコードでどうでしょうか。 Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft

Sub test() Dim r As Long, c1 As Long, c2 As Long For r = 2 To ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 For c1 = 1 To 5 If Cells(r, c1).Value = "" Then For c2 = c1 + 1 To 6 If Cells(r, c2).Value <> "" Then Cells(r, c1).Value = Cells(r, c2).Value Cells(r, c2).ClearContents Exit For End If Next c2 End If Next c1 Next r End Sub 結構無駄なことをしているので、もっと時間短縮できるスマートなマクロもあると思います。