| |
こんにちは。かみちゃん です。
>タックシールはA列とB列のみを使用し、1枚のｼｰﾙがA1からA5で出来ています。
>次にB1〜B5を使って同じシールを作り、次にA6〜A10、次にB6〜B10の順に指定枚数（C/T数）作りたいのです。
>そのコピーする順番を指定するのと、「C/T」数のセルに入っている数分繰り返すところがよくわからないのです。
とりあえず、以下のような感じでいかがでしょうか？
Sub 貼付3()
Dim lngRow As Long
Dim lngTuckRow As Long
Dim cntCT As Integer
lngTuckRow = 1
'Sheet1の5行目〜10行目までを処理する場合
For lngRow = 5 To 10
Sheets("Sheet2").Range("A" & lngTuckRow).Value = Sheets("Sheet1").Range("A" & lngRow).Value
Sheets("Sheet2").Range("A" & lngTuckRow + 1).Value = Sheets("Sheet1").Range("E" & lngRow).Value
Sheets("Sheet2").Range("A" & lngTuckRow + 2).Value = Sheets("Sheet1").Range("B" & lngRow).Value
Sheets("Sheet2").Range("A" & lngTuckRow + 3).Value = Sheets("Sheet1").Range("C" & lngRow).Value
Sheets("Sheet2").Range("A" & lngTuckRow + 4).Value = Sheets("Sheet1").Range("D" & lngRow).Value
Sheets("Sheet2").Range("A" & lngTuckRow + 5).Value = Sheets("Sheet1").Range("F" & lngRow).Value
cntCT = Sheets("Sheet1").Range("G" & lngRow).Value
If cntCT >= 2 Then
Sheets("Sheet2").Range("A" & lngTuckRow).Resize(6).Copy Sheets("Sheet2").Range("B" & lngTuckRow)
If cntCT >= 2 Then
Sheets("Sheet2").Range("A" & lngTuckRow).Resize(6, 2).Copy _
Sheets("Sheet2").Range("A" & lngTuckRow).Resize(6 * Int((cntCT + 1) / 2), 2)
End If
'C/T数が奇数の場合は、B列の最終行から6行を消去
If cntCT Mod 2 = 1 Then
Sheets("Sheet2").Range("B" & lngTuckRow).Offset(6 * Int(cntCT / 2)).Resize(6).ClearContents
End If
End If
lngTuckRow = lngTuckRow + 6 * (Int((cntCT + 1) / 2))
Next
End Sub
ポイントは、C/T数を2で割った数（小数点の場合は切上）分A列とB列を6行単位
でコピーしているところです。
C/T数が奇数の場合は、B列の最後の6行は余分なので消去しています。
これをSheet1の必要な行数分繰り返しています。（下記コードでは、5行目〜10行目までを処理しています）
|
|
かみちゃん
- 07/11/4(日) 17:44 -
