Excel VBA質問箱 IV

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

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


63735 / 76732 ←次へ | 前へ→

【17591】転記がうまく出来ない
質問  NAO  - 04/9/2(木) 23:46 -

引用なし
パスワード
   こんばんは、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の内容をラベルシートの左側にうまく敵されますが、右側には何も転記されません。

うまく説明出来ておらず、分かりづらい質問ですがよろしくお願いします。
0 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 お礼

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