さまざまなシートをコピーして、ブック内の中央の[インポート]タブに貼り付ける作業をしています。シートはそれぞれテンプレートであり、記入されているものと記入されていないものがあります。とにかく、セルはテンプレートで埋められるため、真に「空の」シートはありません。（テンプレートを超えて）追加されたデータのみを取り込みたい。データが追加されていない場合、ソースの最後の行= 11です。lrs= 11の場合はシートをコピーせず（ただし、lrs> 11の場合はデータをコピーする）、代わりに次のシートに移動するようにコードを変更するにはどうすればよいですか。 ？
For i = 1 To Sheets.Count
If Sheets(i).Name <> "Import" And Sheets(i).Name <> "Cover page" And Sheets(i).Name <> "Introduction" And Sheets(i).Name <> "Additional Fuels" Then
With Sheets(i)
lrs = .Cells(.Rows.Count, "S").End(xlUp).Row 'Column S = "Specific Claim Language"
.Range(.Cells(11, "B"), .Cells(lrs, "U")).Copy 'Data of interest exists from B to U
End With
With Sheets("Import")
lrd = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range(.Cells(lrd + 1, "A"), .Cells(lrd + 1 + lrs, "AA")).PasteSpecial xlValues 'Only pasting data relevant to columns B:U on source, A:T on destination
End With
End If
Next i
lrsコピーする前に11よりも優れていることを確認し、貼り付ける前に同じことを行ってください。
Option Explicit
Sub test()
For i = 1 To Sheets.count
If Sheets(i).Name <> "Import" And Sheets(i).Name <> "Cover page" And Sheets(i).Name <> "Introduction" And Sheets(i).Name <> "Additional Fuels" Then
With Sheets(i)
lrs = .Cells(.Rows.count, "S").End(xlUp).Row 'Column S = "Specific Claim Language"
If lrs > 11 Then
.Range(.Cells(11, "B"), .Cells(lrs, "U")).Copy 'Data of interest exists from B to U
End if
End With
If lrs > 11 Then
With Sheets("Import")
lrd = .Cells(.Rows.count, "A").End(xlUp).Row
.Range(.Cells(lrd + 1, "A"), .Cells(lrd + 1 + lrs, "AA")).PasteSpecial xlValues 'Only pasting data relevant to columns B:U on source, A:T on destination
End With
End If
End If
Next i
End Sub
または、12未満のチェック後に飛び出して再開します
Option Explicit
Sub test()
For i = 1 To Sheets.count
If Sheets(i).Name <> "Import" And Sheets(i).Name <> "Cover page" And Sheets(i).Name <> "Introduction" And Sheets(i).Name <> "Additional Fuels" Then
With Sheets(i)
lrs = .Cells(.Rows.count, "S").End(xlUp).Row 'Column S = "Specific Claim Language"
If lrs < 12 Then GoTo nextsheet:
.Range(.Cells(11, "B"), .Cells(lrs, "U")).Copy 'Data of interest exists from B to U
End With
With Sheets("Import")
lrd = .Cells(.Rows.count, "A").End(xlUp).Row
.Range(.Cells(lrd + 1, "A"), .Cells(lrd + 1 + lrs, "AA")).PasteSpecial xlValues 'Only pasting data relevant to columns B:U on source, A:T on destination
End With
End If
nextsheet:
resume nextsheet2:
nextsheet2:
Next i
End Sub
この記事はインターネットから収集されたものであり、転載の際にはソースを示してください。
侵害の場合は、連絡してください[email protected]
コメントを追加