|
実は、知恵袋で同様の質問をさせていただいたのですが、
文字数の制限があったり、書き直しが出来なかったりで、
使いにくかったので、再度こちらに質問させて頂きます。
目的はデータベースから、発注書フォーマットへの転記です。
知恵袋で教えていただいたのを修正したりしながら、
試行錯誤しているのですが、どうしてもきちんと転記されないです。
コードは以下の通りです。
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
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
自分では、
For i = 15 To 22
If mySh2.Range("A" & i) = "" Then
myRow = i
Exit For
の部分が問題ではないかと思っているのですが、
色々変えてみても上手くいかないので、行き詰ってます。
何卒、ご指南のほどよろしくお願い致します。
|
|