ExcelVBAで複数のブックからデータを別ブックのシートに横に貼り付けるには

Question

###前提・実現したいこと
ここに質問したいことを詳細に書いてください
ExcelVBAで基本統計量を計算するツールを作っています。
複数のブック（例：ブック名”2016/05”など）から、1企業1シートで、シートの右方向に年度順に並べて貼り付けていきます。その際、特定の列のみを抽出し、かつ、フィールドの見出し（1行目）を除いて貼り付けていきたいと考えております。
お尋ねしたいのは、ある年度において、企業のデータ複数のブック（複数月）にまたがっている場合に5月6月という順番で列方向に隙間なく並べていくにはどうしたらよいのかということと、シートの右方向に並べて貼り付ける方法です。
ファイルは一つｎフォルダに2016/5,2016/06、2015/04-05,2015/06,2014/04-05,2014/06という風にはいっています。
現在は、以下のようコードまで書きました。この後どのようにコードを書いていけばよいかご教授ください。よろしくお願い申し上げます。

###発生している問題・エラーメッセージ

エラーメッセージ

###該当のソースコード
Sub sample()
Application.ScreenUpdating = False
Dim vBk As Workbook

Set vBk = Workbooks.Open(ThisWorkbook.Path & "\Book2.xlsx")
vBk.Worksheets("Sheet1").Range("A1").AutoFilter field:=5, Criteria1:="A株式会社"
vBk.Worksheets("Sheet1").Range("A1").CurrentRegion.Resize(.Rows.Count - 1).Offset(1).Copy
ThisWorkbook.Worksheets("Sheet2").Paste
ThisWorkbook.Worksheets("Sheet2").Columns(1).Delete
ThisWorkbook.Worksheets("Sheet2").Columns(1).Delete
ThisWorkbook.Worksheets("Sheet2").Columns(1).Delete
ThisWorkbook.Worksheets("Sheet2").Columns(1).Delete
vBk.Close

End Sub
###試したこと
横に貼り付けるするために、
With ThisWorkBook.Worksheets("sheet2")
.Activate
.Cell(.Columns.Count,1).Offset(1).Activate
.Paste
End With
を調べて試しましたがうまくいきませんでした。
###補足情報(言語/FW/ツール等のバージョンなど)
Excel2010, Win7

Answer 1

年度のデータということですのでforを使って1月から12月までのデータを開いていく感じだと思います。
その際に、ファイルの存在を確認し、ファイルがある場合のみ処理を行うようにしましょう。
また、列方向に隙間なく並べるということなので、もとになるファイルが何列あるかを取得してその列の＋１列目に
データを貼り付けるようにすれば良いと思います。

あくまでも参考ですが、下記のような感じかと思います。

    Set vBk = Workbooks.Open(ThisWorkbook.Path & "\Book2.xlsx")
    
    '1月から12月までループする
    For i = 1 To 12
        
     'ファイル名を取得する ※ファイル名が201601の場合
     Filename = "2016" & Format(i, "00") & ".xls"
    
     'ファイルの存在を確認する
     If Dir(ThisWorkbook.Path & "\" & Filename) <> "" Then
        
        'ファイルがある場合
        Set work = Workbooks.Open(ThisWorkbook.Path & Filename)
        
        'コピーする範囲を指定する
        vBk.Worksheets("Sheet1").Range("A1").AutoFilter field:=5, Criteria1:="A株式会社"
        
        'コピーする
        vBk.Columns("E:E").Copy
        
        'vBkの列が何列あるか取得する
        c = vBk.Range("A1").CurrentRegion.Columns.Count
        
        'vBkの列の＋1列目に貼り付ける
        vBk.Cells(1, c + 1).Paste
        
        '保存せずに閉じる
        work.Close SaveChanges:=False
                
     End If
    
      '繰り返す
    Next

Answer 2

質問の内容について

①情報の提示は正確にお願いします。
ブック名＝ファイル名だと思いますが、Windows7ではファイル名に/を含めることはできません。
このため2016/04のようなブック名はありえないと思います。

今回はブック名から年月を判断するということでしたので、この部分の情報提供は正確にお願いします。

②うまく動かない？
「試してみたがうまく動きませんでした」という質問者さんはよくいますが、どう動いてほしかったけど、どういう動きをしてしまう（＝うまく動かない）という説明がありません。
期待する動きと、ダメだった動き（エラーが発生したとか、何も出力されなかったとか）を詳しく記載していただけると回答しやすくなります。

アドバイス①

まず「試したこと」のコードについてのアドバイスです。

おそらく、データの存在する最終列の右隣の列にデータを貼り付けたいのではないかと思いますが、記述されたコードにはいくつか間違いがあります。

①Cellsの指定はCells(行,列)
.Cellsでの座標指定は、(X, Y)の座標指定のように勘違いされる方も多いですが、Cells(行番号, 列番号)の順です。
同様にOffsetも第一引数は行数です。
右にひとつずらした列を指定する場合、.Offset(,1)とする必要があります。

②Column.Countは利用可能な最大列番号
Column.Countで取得できる値は、Excel上で利用できる最大列番号です。
Excel2010ではXFD列(16384)が返されます。

データのある最終列を取得したい場合は、例えば.Cells(1, .Columns.Count).End(xlToLeft)のように記述することで1行目の最終データのセルを取得できます。
(利用可能な最終列から「Ctrl + ←」をした位置、という意味合いです。)

以上を踏まえて、提示されたコードを意図した動きにするには

With ThisWorkBook.Worksheets("sheet2") 
    .Activate 
    .Cell(1, .Columns.Count).End(xlToLeft).Offset(,1).Activate 
    .Paste 
End With 

のようなコードになると思います。

アドバイス②

目的の動作を行うために、フォルダ内のファイルを順次取得して、ファイル名を判断しながら処理を行う必要があると思います。

そのひとつの方法として、以下のようなやり方があります。

    Dim strFileName As String
    Dim lRow As Long
    
    'フォルダ内の.xlsxファイルを取得
    strFileName = Dir(ThisWorkbook.Path & "*.xlsx")
    
    lRow = 0
    
    Do While strFileName <> ""
        'ファイル名を利用して操作(このサンプルではファイル名をセルに出力するだけ)
        lRow = lRow + 1
        Cells(lRow, 1) = strFileName
        
        '次のファイル名を取得
        strFileName = Dir()
    Loop

冒頭にも書きましたが、実際に取得されるファイル名(ブック名)がよくわからないのと、複数月にまたがるファイルでどんな動作をしたいのかなど、細かな部分がわかりませんのでファイル名を取得して利用する部分だけ記述させていただきました。

---

長文になってしまいましたが参考になれば幸いです。
がんばってください。