Excel VBA質問箱 IV

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

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


63711 / 76732 ←次へ | 前へ→

【17615】Re:転記OKです!
お礼  NAO  - 04/9/3(金) 12:50 -

引用なし
パスワード
   ▼かみちゃん さん:
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
> 'データシートより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 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


本当にありがとうございました。
1 hits

【17591】転記がうまく出来ない NAO 04/9/2(木) 23:46 質問
【17596】Re:転記がうまく出来ない ichinose 04/9/3(金) 7:09 発言
【17602】Re:転記がうまく出来ない NAO 04/9/3(金) 9:43 質問
【17603】Re:転記がうまく出来ない かみちゃん 04/9/3(金) 10:14 回答
【17604】Re:試みてみます NAO 04/9/3(金) 10:49 質問
【17617】Re:ありがとうございました NAO 04/9/3(金) 12:58 お礼
【17601】Re:転記がうまく出来ない かみちゃん 04/9/3(金) 9:33 回答
【17615】Re:転記OKです! NAO 04/9/3(金) 12:50 お礼
【17619】Re:印刷部分が・・ NAO 04/9/3(金) 14:02 質問
【17620】Re:印刷部分が・・ かみちゃん 04/9/3(金) 14:17 回答
【17622】Re:印刷部分が・・うまくいきました NAO 04/9/3(金) 14:33 お礼

63711 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free