| |
▼かみちゃん さん：
NAOです。
[17603]で回答いただきましたコードで希望しているとおりに作動しました。
ありがとうございました。
>Private Sub CommandButton1_Click()
> Dim lstrow As Integer, a As Integer, m As Integer, h As Integer, i As Integer, j As Integer
> Dim z As Integer
>
> Application.ScreenUpdating = False
> 'データシートより５行づつ、作業用シートに取り込む
> 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 j = h - (z - 1) * 5 To i - (z - 1) * 5
> '名前
> Worksheets("ラベル").Cells(j * 10 - 18, 18- (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 2).Value
> '備考
> Worksheets("ラベル").Cells(j * 10 - 18, 23- (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 4).Value
> '品名
> Worksheets("ラベル").Cells(j * 10 - 11, 20- (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 3).Value
> '番号
> Worksheets("ラベル").Cells(j * 10 - 11, 28- (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 1).Value
> Next j
> 'ラベルシートの印刷
> MsgBox "用紙をセットしてください"
> Worksheets("ラベル").Activate
> ActiveSheet.PrintOut copies:=1
> Next z
> MsgBox "すべての印刷終了"
> Application.ScreenUpdating = True
>End Sub
本当にありがとうございました。
|
|
ＮＡＯ
- 04/9/3(金) 12:50 -
