指定セルへ転記するマクロで値が無い場合固定値転記
シート２の1行目の指定したセルの値をシート１の指定セルに
転記を行いシート１が印刷。
印刷後はシート２の2行目の指定したセルの値をシート１の指定したセルに
転記してシート１が印刷。
シート２にデータが無くなったら停止という以下のマクロにて
シート２のＯ列はシート１のセルA19に順次転記なのですが
Ｏ列は運用上空白が有る場合が判明した為
値がある場合はその値を転記、値が無い場合は半角で ZZZ と
転記をしたいのですがどこを変更していいのか分かりません。
よろしくお願いします。
Sub データ転記()
Dim myRng(1 To 23)
Dim cpRng
Dim i As Integer
Dim n As String, myStr As String
With Sheets("Sheet2")
Set myRng(1) = .Range("B2")
Set myRng(2) = .Range("C2")
Set myRng(3) = .Range("D2")
Set myRng(4) = .Range("D2")
Set myRng(5) = .Range("D2")
Set myRng(6) = .Range("E2")
Set myRng(7) = .Range("E2")
Set myRng(8) = .Range("F2")
Set myRng(9) = .Range("F2")
Set myRng(10) = .Range("H2")
Set myRng(11) = .Range("J2")
Set myRng(12) = .Range("K2")
Set myRng(13) = .Range("K2")
Set myRng(14) = .Range("L2")
Set myRng(15) = .Range("M2")
Set myRng(16) = .Range("N2")
Set myRng(17) = .Range("O2")
Set myRng(18) = .Range("P2")
Set myRng(19) = .Range("Q2")
Set myRng(20) = .Range("R2")
Set myRng(21) = .Range("S2")
Set myRng(22) = .Range("U2")
Set myRng(23) = .Range("G2")
End With
cpRng = Split("B10,O4,G3,F10,F13,G10,G13,H10,H13,O3,L10,M10,M13,O5,E19,F19,A19,O6,D21,B6,I19,J19,G5", ",") '転記先配列化
With Sheets("Sheet1")
.Range("B10,G3,F10,F13,G10,G13,L10,E19,F19,J19,O7,O8,C19,D10,D13,A19,O4,O5").NumberFormatLocal = "@"
Do While myRng(1) <> ""
For i = 1 To 23
.Range(cpRng(i - 1)).Value = myRng(i).Value
Next
.Range("C3,C13").Value = Left(.Range("O3").Value, 10)
.Range("C10").Value = Mid(.Range("O3"), 11, 6)
.Range("O7").Value = Format(Range("O6").Value, "0000000")
.Range("O8").Value = Format(Range("J19").Value, "0000000")
Call 加工01
Call 加工02
'印刷
.PrintOut
For i = 1 To 23
Set myRng(i) = myRng(i).Offset(1)
Next i
Loop
.Range("B10,O4,G3,F10,F13,G10,G13,H10,H13,O3,L10,M10,M13,O5,E19,F19,A19,O6,D21,B6,I19,J19,C3,C10,C13,C19,D10,D13,O8,O7,G5").ClearContents
End With
For i = 1 To 23
Set myRng(i) = Nothing
Next
MsgBox "印刷終了"
Sheets("Sheet2").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("Sheet1").Select
Range("C3").Select
End Sub
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/images/related_qa/c205_4_thumbnail_img_sm.png)
お礼
出来ました♪ ありがとうございました＾＾