Excel VBA質問箱 IV

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

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


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

11543 / 76734

←次へ　｜　前へ→


	【70725】Re:データベースからの転記について

Hirofumi - 11/12/20(火) 12:53 -


	引用なし

	パスワード

Sub Macro()
　　
　　Dim mySh1, mySh2, i, myRow, actRow
　　
　　If TypeName(Selection) <> "Range" Then
　　　　MsgBox "A列のセルを選択して下さい(終了)"
　　　　Exit Sub
　　End If
　　
　　actRow = ActiveCell.Row
　　If Sheets(Sheets.Count).Name <> "New" Then
　　　　Sheets("発注書").Copy After:=Sheets(Sheets.Count)
　　　　ActiveSheet.Name = Format(Now, "yymmdd_hhmmss")
　　End If
　　
　　Set mySh1 = Sheets("一覧")
　　Set mySh2 = ActiveSheet
　　
　　For i = 15 To 22
　　　　If mySh2.Range("A" & i) = "" Then
　　　　　　myRow = i
　　　　　　Exit For
　　　　End If
　　Next i
　　
　　If myRow = 0 Then
　　　　MsgBox "空欄がありません！"
　　End If
　　
　　Exit Sub '此処でSubから無条件で抜けているので、以降のコードは実行されないよ？？
　　
　　With mySh2
　　　　.Range("F" & myRow).Value = mySh1.Range("A" & actRow).Value
　　　　.Range("A" & myRow).Value = mySh1.Range("B" & actRow).Value
　　　　.Range("G" & myRow).Value = mySh1.Range("C" & actRow).Value
　　　　.Range("H" & myRow).Value = mySh1.Range("D" & actRow).Value
　　　　.Range("G11").Value = mySh1.Range("E" & actRow).Value
　　　　.Range("A3").Value = mySh1.Range("F" & actRow).Value
　　　　.Range("A1").Value = mySh1.Range("G" & actRow).Value
　　　　.Range("I2").Value = mySh1.Range("H" & actRow).Value
　　　　.Range("I12").Value = mySh1.Range("I" & actRow).Value
　　　　.Range("I" & myRow).Value = mySh1.Range("J" & actRow).Value
　　　　.Range("B23").Value = mySh1.Range("K" & actRow).Value
　　　　.Range("I5").Value = mySh1.Range("L" & actRow).Value
　　End With
　　
　　mySh2.Select
　　
　　Set mySh1 = Nothing
　　Set mySh2 = Nothing
　　
End Sub

3 hits

▼

【70724】データベースからの転記について うろ 11/12/20(火) 11:42