こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBA 100行ごとに列を変更してコピーする。

Winは7、Excelは2013を使用しています。
A列とB列のデータを100行毎に列を変えてコピーしたいと思っています。
(画像参照願います。)
それで、別シートにコピペするサンプルコードを見つけたのですが、
同シート内でする様に変更する知識がなく、苦戦しています。
申し訳ありませんが、ご教示願います。

別シートにコピペするサンプルコード
Sub データを100行ごとに分割する()
Dim シート As Worksheet, 元 As Worksheet '元は元データのあるシート
Dim 総行数 As Long, 回数 As Long, i As Long, 開始行 As Long
Const コピー行 = 100
Set 元 = ActiveSheet '変数の元をActiveSheetにセットする
総行数 = 元.UsedRange.Rows.Count
回数 = Int(総行数 / コピー行) + IIf(総行数 Mod コピー行 > 0, 1, 0)
開始行 = 1
For i = 1 To 回数
Set シート = Sheets.Add
シート.Name = 開始行 & "~" & 開始行 + コピー行 - 1
元.Rows(開始行 & ":" & 開始行 + コピー行 - 1).Copy シート.Range("A1")
Columns("A:F").AutoFit
開始行 = 開始行 + コピー行
Next i
End Sub

投稿日時 - 2018-06-11 11:45:21

QNo.9507224

困ってます

質問者が選んだベストアンサー

手抜き版です。
A,B列の102行目以降を削除する処理は入れてません。

Sub Sample()
  コピー行 = 100
  回数 = Int((Range("A1").End(xlDown).Row - 2) / コピー行)
  For i = 1 To 回数
    nRow = i * コピー行 + 2
    Range(Cells(2, i * 2 + 1), Cells(1 + コピー行, i * 2 + 2)) = Range(Cells(nRow, 1), Cells(nRow + コピー行 - 1, 2)).Value
  Next i
End Sub

投稿日時 - 2018-06-11 13:31:38

お礼

mt2015様

ご回答いただきありがとうございます。
希望通りの処理が出来ました。

102行目以降を削除する処理は、がんばってみます。

いつもご回答いただき、感謝しております。

投稿日時 - 2018-06-11 15:04:55

ANo.3

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

繰り返し法ですが、コピー貼り付などを使って、コード行数を最小限(結果6行、MAGBOX除いて)になるように考えた。

データは、1シートのA,B列にあり、結果をC列以右に、コードと名称の、2列づつ出すとして
Sub test01()
lr = Range("a100000").End(xlUp).Row
MsgBox lr
bs = Int(lr / 20) + 1
MsgBox bs
For i = 1 To bs
ActiveSheet.Range("A" & ((i - 1) * 20 + 2) & ":B" & (i * 20) + 2).Copy Cells(2, (i * 2 + 1))
Next i
End Sub
ただし当方のテストでの確認のため20行ごとに分割してやってみたので、100行ごとの場合は、VBAコード内で、20のところを、すべて100に修正してください。

投稿日時 - 2018-06-11 14:23:54

お礼

imogasi様

ご回答いただきありがとうございます。
できましたら、1~101行まではA列B列のままで、
102行目をC列以降に100行づつコピペしたかったのです。
申し訳ありません。

投稿日時 - 2018-06-11 15:07:59

ANo.2

すみません、絶対参照にするのを忘れていました。また、スペースの時0が出ます。
少し長いですが、
C2 =IF(INDEX($A:$A,ROW(A2)+COLUMN(A2)*50-50,1)="","",INDEX($A:$A,ROW(A2)+COLUMN(A2)*50-50,1))
D2 =IF(INDEX($B:$B,ROW(A2)+COLUMN(A2)*50-50,1)="","",INDEX($B:$B,ROW(A2)+COLUMN(A2)*50-50,1))
にして下さい。

投稿日時 - 2018-06-11 13:14:18

お礼

SI299792様

ご回答ありがとうございます。
申し訳ありませんが、VBAを希望しております。

投稿日時 - 2018-06-11 15:01:49

ANo.1

C2 =INDEX(A:A,ROW(A2)+COLUMN(A2)*50-50,1)
D2 =INDEX(B:B,ROW(A2)+COLUMN(A2)*50-50,1)
として、右下 101行までコピペすれば、関数でできます。
値にしたければ、コピー、形式を選択して貼り付け、値を行ってください。
どうしてもVBA がいいなら、作りますが、これから忙しいので明日になります。他の人に作ってもらった方が早いです。

投稿日時 - 2018-06-11 13:02:19

お礼

SI299792様

ご回答ありがとうございます。
申し訳ありませんが、VBAを希望しております。

投稿日時 - 2018-06-11 15:01:27