|    | 
     こんにちは。かみちゃん です。 
 
表がなんとなくずれているように思いますが、以下のような表でいいのでしょうか? 
 
  A    B   C  D  E  F  G  H  I 
1         1  2  3  4  5 
2 コード 科目 
3   1 現金       ○ 
4   2 手形  ○ 
5   3 売掛  ○   ○ 
6   4 買掛    ○ 
7   5 雑収      ○ 
8 
 
> 科目をシート2のA20から左詰で表示させたい 
 
A20セル1つにまとめて表示したいということですね? 
 
以下のような感じでできると思います。 
 
Sub Sample1() 
 Dim c As Range 
 Dim LastCell As Range 
 Dim rng As Range 
 Dim strKamoku As String 
  
 With Sheets("Sheet1") 
  Set LastCell = .Cells(Rows.Count, 1).End(xlUp) 
  On Error Resume Next 
  Set rng = .Range("A3", LastCell). _ 
   Offset(, Val(Sheets("Sheet2").Range("A1").Value) + 1) _ 
   .SpecialCells(xlCellTypeBlanks) 
  On Error GoTo 0 
  If Not rng Is Nothing Then 
   For Each c In rng 
    strKamoku = strKamoku & .Cells(c.Row, 2).Value & vbCrLf 
   Next 
   Sheets("Sheet2").Range("A20").Value = Left(strKamoku, Len(strKamoku) - 1) 
  End If 
 End With 
End Sub 
 
 | 
     
    
   |