|
こんばんは、NAOです。またお世話になります。
下記のコードは、データシートの内容を一部づつ作業用シートにコピーし、作業用シートからラベルシートに転記し、印刷、次のデータを同じようにコピー、転記、印刷したいと思って作成したのですが、うまく思っているように出来ません。
どこがまずいのかご指摘ねがいたいと思います。よろしくお願いします。
(データシート)・・・データ数は一定ではありません
a b c d
1 番号 名前 品名 備考
2 1 井上 定規 1組
3 2 坂本 鉛筆 1ダース
4 3 中村 ペン 赤色
. . . . .
. . . . .
まず、データシートの番号1〜5(2行目から6行目)を作業シートのセル"A1"にコピーする。
作業用シートの内容をラベルシートの右側半分の所定の位置に転記する。
引き続き、データシートの番号6〜10(7行目から11行目)を作業シートのセル"A1"にコピーする。
作業用シートの内容をラベルシートの左側半分の所定の位置に転記する。
ラベルシートを印刷する。
上記の手順を、データシートの最終番号まで繰り返す。
転記先のラベルシートの所定の位置ですが、一寸文章で書くとややこしいのですが、次のとおりです。
(作業シート)⇒(ラベルシート右側) (ラベルシートの左側)
1行目の A1 ⇒ M9 AB9
データ B1 ⇒ C2 R2
C1 ⇒ E9 T9
D1 ⇒ H2 W2
2行目の A2 ⇒ M19 AB19
データ B2 ⇒ C12 R12
C2 ⇒ E19 T19
D2 ⇒ H12 W12
以下、5行目まで同じ間隔でコピーします。
データシート上のコマンドボタンにより転記。コードは次のようになっています。
Private Sub CommandButton1_Click()
Dim lstrow As Integer, a As Integer, m As Integer, n As Integer, h As Integer,i As Integer, j As Integer, k As Integer, p As Integer, q As Integer
Application.ScreenUpdating = False
'データシートより5行づつ、作業用シートに取り込む
Worksheets("データ").Activate
lstrow = Worksheets("データ").Range("a65536").End(xlUp).Row
a = lstrow
m = WorksheetFunction.RoundUp(a / 5, 0)
For z = 1 To m
h = z * 5 - 3
i = z * 5 + 1
Worksheets("データ").Range("a" & h & ":d" & i).Copy Destination:=Worksheets("作業用").Range("a1")
'作業用シートのデータをラベルシートに転記する
For n = 1 To 2 '1シートに10行分転記する
'名前
For j = h To i
If n Mod 2 = o Then
Worksheets("ラベル").Cells(j * 10 - 18, 3).Value =Worksheets("作業用").Cells(j - 1, 2).Value
Else: Worksheets("ラベル").Cells(j * 10 - 18, 18).Value = Worksheets("作業用").Cells(j + 4, 2).Value
End If
Next j
'備考
For k = h To i
If n Mod 2 = o Then
Worksheets("ラベル").Cells(k * 10 - 18, 8).Value = Worksheets("作業用").Cells(k - 1, 4).Value
Else: Worksheets("ラベル").Cells(k * 10 - 18, 23).Value = Worksheets("作業用").Cells(k + 4, 4).Value
End If
Next k
'品名
For p = h To i
If n Mod 2 = o Then
Worksheets("ラベル").Cells(p * 10 - 11, 5).Value = Worksheets("作業用").Cells(p - 1, 3).Value
Else: Worksheets("ラベル").Cells(p * 10 - 11, 20).Value = Worksheets("作業用").Cells(p + 4, 3).Value
End If
Next p
'番号
For q = h To i
If n Mod 2 = o Then
Worksheets("ラベル").Cells(q * 10 - 11, 13).Value = Worksheets("作業用").Cells(q - 1, 1).Value
Else: Worksheets("ラベル").Cells(q * 10 - 11, 28).Value = Worksheets("作業用").Cells(q + 4, 1).Value
End If
Next q
Next n
'ラベルシートの印刷
MsgBox "用紙をセットしてください"
Worksheets("ラベル").Activate
ActiveSheet.PrintOut copies:=1
Next z
MsgBox "すべての印刷終了"
Application.ScreenUpdating = True
End Sub
上記を作動させますと、1回目の番号1から5の内容をラベルシートの左側にうまく敵されますが、右側には何も転記されません。
うまく説明出来ておらず、分かりづらい質問ですがよろしくお願いします。
|
|