| |
▼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 '伝票備考１
.Range("P1").Value = wst1.Range("A19").Value '伝票備考２
End With
newRow = newRow + 1 'つぎの行
End If
Next i
End Sub
|
|
kanabun
- 15/5/15(金) 17:53 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
