Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1049 / 76807

←次へ　｜　前へ→


	【81417】Re:表を加工して別ｼｰﾄに転記したい

マナ - 20/7/26(日) 13:10 -


	引用なし

	パスワード

▼ありすさん：

修正してみました。

>　なぜか、データの項目名から取ってきてしまう場合が5回に1回くらい起こって>しまった。→未解決

>Sheet1.Range("C6:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy

Cells(Rows.Count, "E")の前にも、シート指定が必要です。

Sub tenki2()
　　Dim k As Long, g As Long 'k=期間　g=繰り返し用
　　Dim MaxRow1 As Long, MaxRow2 As Long
　　Dim kaishi As Date '開始日
　　Dim shuryo As Date '終了日
　　Dim h As Date '日付入力用
　　
　　'変数"k"に期間(何か月)をセット
　　k = Sheet1.Range("B5")
　　kaishi = Sheet1.Range("B6")
　　
　　For g = 1 To k
　　'sheet1のデータをsheet2に貼り付け
　　If Sheet2.Range("C6") = "" Then
　　　　MaxRow1 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row + 1
　　　　Sheet1.Range("C6:K" & Sheet1.Cells(Rows.Count, "E").End(xlUp).Row).Copy
　　　　Sheet2.Range("C6").PasteSpecial
　　　　MaxRow2 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row
　　Else
　　　 MaxRow1 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row + 1
　　　　Sheet1.Range("C6:K" & Sheet1.Cells(Rows.Count, "E").End(xlUp).Row).Copy
　　　　Sheet2.Range("C" & MaxRow1).PasteSpecial
　　　　MaxRow2 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row
　　End If
　　'日付の入力
　　h = DateSerial(Year(kaishi), Month(kaishi) + g, 0)
　　Sheet2.Range("D" & MaxRow1 & ":D" & MaxRow2).Value = h
　　Next
　　'並べ替え
　　With Sheet2.Sort
　　　　.SortFields.Clear
　　　　.SortFields.Add Key:=Sheet2.Range("C6")
　　　　.SortFields.Add Key:=Sheet2.Range("D6")
　　　　.SetRange Sheet2.Range("C5:K" & MaxRow2)
　　　　.Header = xlYes
　　　　.Apply
　　End With
　　
End Sub

2 hits

▼

【81401】表を加工して別ｼｰﾄに転記したい ありす 20/7/21(火) 15:50