抽出・仕分け先の横一列の行の高さが広がって表示されてしまいます。Sheet1(元データ①)を 下記のコードにて、各シートごとに抽出・仕分けを行っていますがどこかのセル内の文字が多いと、仕分け先で②のように横一列の行の高さが広がって表示されてしまいます。Sheet1(元データ①)のように、仕分け先も 横一列の行の高さが変わらずに表示させることは可能でしょうか。ご教示を何卒お願いいたします。---------------------------------------------Sub 抽出()Dim dic As ObjectDim sh1 As Worksheet, sh2 As WorksheetDim r As LongDim dkey As VariantDim wr As VariantApplication.ScreenUpdating = FalseSet dic = CreateObject(\u0026quot;Scripting.Dictionary\u0026quot;)Set sh1 = ActiveSheetWith sh1For r = 2 To .Cells(Rows.Count, 1).End(xlUp).RowIf IsNumeric(Mid(.Cells(r, 2).Value, 3, 1)) Thendkey = Left(.Cells(r, 2).Value, 2)Elsedkey = Left(.Cells(r, 2).Value, 3)End IfIf dic.exists(dkey) = False Thendic.Add dkey, rElsedic.Item(dkey) = dic.Item(dkey) \u0026amp; \u0026quot;,\u0026quot; \u0026amp; rEnd IfNext rEnd WithFor Each dkey In dic.keysSet sh2 = Worksheets.Add(After:=Worksheets(Worksheets.Count))With sh2r = 0.Name = dkeyFor Each wr In Split(dic.Item(dkey), \u0026quot;,\u0026quot;)r = r + 1.Cells(r, 1).Resize(, 4).Value = sh1.Cells(wr, 1).Resize(, 4).ValueNext wrEnd WithNext dkeySet dic = NothingApplication.ScreenUpdating = TrueEnd Sub