Excel VBA質問箱 IV

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

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


5258 / 76732 ←次へ | 前へ→

【77087】Re:設定済のテーブル内への転記
発言  kanabun  - 15/5/15(金) 17:53 -

引用なし
パスワード
       ▼doro さん:

もし、上のようなことが関係しているのなら、
End(xlUp) で求めた最下行が [A1]のとき、
値のある/なし で、以下のように分岐してはいかがでしょう?

Sub 明細保存1()
 Dim wst1 As Worksheet   'コピー元
 Dim wst2 As Worksheet   '転記先
 Dim i As Long       'ループ用
 Dim LastCell As Range   'データ最終セル
 Dim newRow As Long    '貼付先行番号
 Dim No As Long      '伝票番号

 Set wst1 = ActiveSheet     '入力元が複数パターンあるので
 Set wst2 = ThisWorkbook.Worksheets("DB")

 Set LastCell = wst2.Range("A" & Rows.Count).End(xlUp)
 If LastCell.Row = 1 Then    '一行目のとき
   If IsEmpty(LastCell) Then  '未入力なら
     newRow = 1
     No = 1
   Else            'すでに書き込みあれば
     newRow = 2
     No = 2
   End If
 Else
   newRow = LastCell.Row + 1
   No = LastCell.Value + 1
 End If

 For i = 21 To 47
  If wst1.Range("G" & i) = "" Then
    Exit For
  Else
   With wst2.Range("A" & newRow)
    .Value = No            '伝票番号
    .Range("B1").Value = wst1.Range("H2").Value  '日付
    .Range("C1").Value = wst1.Range("A3").Value  '発注先
    .Range("D1").Value = wst1.Range("B9").Value  '件名
    .Range("E1").Value = wst1.Range("B11").Value  '納品先
    .Range("F1").Value = wst1.Range("I15").Value  '発注者
 
    .Range("G1").Value = wst1.Range("A" & i).Value  '品名
    .Range("H1").Value = wst1.Range("D" & i).Value  '仕様
    .Range("I1").Value = wst1.Range("G" & i).Value  '数量
    .Range("J1").Value = wst1.Range("F" & i).Value  '単位
    .Range("K1").Value = wst1.Range("H" & i).Value  '備考
 
    .Range("L1").Value = wst1.Range("B14").Value  '希望納期
    .Range("N1").Value = "FAX"  '注文方法
    .Range("O1").Value = wst1.Range("A18").Value  '伝票備考1
    .Range("P1").Value = wst1.Range("A19").Value  '伝票備考2
   End With
   newRow = newRow + 1 'つぎの行
  End If
 Next i
End Sub

307 hits

【77085】設定済のテーブル内への転記 doro 15/5/15(金) 16:32 質問[未読]
【77086】Re:設定済のテーブル内への転記 kanabun 15/5/15(金) 17:27 発言[未読]
【77088】Re:設定済のテーブル内への転記 doro 15/5/15(金) 18:00 発言[未読]
【77089】Re:設定済のテーブル内への転記 kanabun 15/5/15(金) 18:40 発言[未読]
【77099】Re:設定済のテーブル内への転記 doro 15/5/18(月) 16:42 発言[未読]
【77087】Re:設定済のテーブル内への転記 kanabun 15/5/15(金) 17:53 発言[未読]

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