Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


33444 / 76734 ←次へ | 前へ→

【48508】セル値の転記について 48324に関連してます
質問  還暦おやじ  - 07/4/19(木) 22:02 -

引用なし
パスワード
   Sub MyShop_SaleData()
  Dim MyF As String
  Dim CkC As Variant
  Dim WS As Worksheet
  Dim xR As Long
  Dim C As Range
  Dim セル,xC,S,CC as variant

  Const Ph As String = _
  "C:\Documents and Settings\User\My Documents\ExcelFiles\"

  Application.ScreenUpdating = False
  Set WS = ThisWorkbook.Worksheets(1)
  MyF = Dir(Ph & "*.xls")
  Do Until MyF = ""
   xR = WS.Cells(65536, 1).End(xlUp).Row + 1
   WS.cells(xR,1).value=Left$(MyF,Len(MyF)-4)
   Workbooks.Open Ph & MyF
   With ActiveWorkbook
     For Each C In .Worksheets(1).range("A1:M1").SpecialCells(2)
      CkC = Application.Match(C.Value, WS.Range("A1:X1"), 0)
      If Not IsError(CkC) Then
        WS.Cells(xR, CkC).Value = C.Offset(1).Value


        thedate=Datepart("yyyy",Date) & "年" & Datepart("m",Date) &"月"
        set セル=.worksheets(1).range("A1:M1").find(thedate,lookin:=xlvalues)
        set cc=WS.range("A1:X1").find(thedate,lookin:=xlvalues)

        If not セル is nothing then
         xR = WS.Cells(65536, 1).End(xlUp).Row
         xC=cc.column
         S=.range(セル,"M1").columns.count
         
         WS.range(xR,xC),resize(,S).value=.cells(1,セル.column).offset(2).resize(,S).value
        End If
      End if
     Next
     .Close False
   End With
   MyF = Dir()
  Loop
  Application.ScreenUpdating = True: Set WS = Nothing
  MsgBox "データの転記を完了しました", 64
End Sub


新宿支店.xls
A       B      C       D    E・・・・・・・M列
      2007年2月  2007年3月  2007年4月 2007年5月・・・2008年1月
売上実績  250      230     0     0
売上目標  200      220     300    300

池袋支店.xls
A       B      C       D    E・・・・・・・M列
      2007年3月  2007年4月  2007年5月 2007年6月・・・2008年2月
売上実績  250      200     0     0
売上目標  200      200     250    300





転記先.xls
A      B       C      D     E・・・・・・・・・X列   
      2007年2月  2007年3月  2007年4月 2007年5月 2007年6月・・
新宿    250      230     300     300
池袋            250     200     250   300

売上実績を転記する方法を48324の質問でさせていただきました。
現在の月(今なら2007年4月)よりあとの部分については売上目標の数字を転記したく、書いてみました。
しかし、2007年4月以降の分についてはresizeで数字を転記するため
転記先のX列を超えて数字が転記されてしまいます。
ここはどう変えるとX列までの転記でいけるのでしょうか。

何卒ご教授頂きたいと思います。
宜しくお願い致します。
1 hits

【48508】セル値の転記について 48324に関連してます 還暦おやじ 07/4/19(木) 22:02 質問

33444 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free