|
こんにちは。
え〜と、はっきり言いまして全然解りません。
シートレイアウト、データ類等、他で手を抜かないで書いてください。
特にデータ量の少なさ...。
なかなか解答がつかないのは、こう言う所が原因かと思います。
ほとんど解っていませんから、適当に作ってみました。
Sub dddrtyjsk()
Dim TB() As String
TBI = 0
For i = 1 To 4
With Sheets("Sheet1")
If .Cells(1, i).Value <> "" Then
TBI = TBI + 1
ReDim Preserve TB(1 To TBI)
TB(TBI) = .Cells(1, i).Value
End If
Ro = 1
Do Until .Cells(Ro, i).End(xlDown).Row = 65536
TBI = TBI + 1
ReDim Preserve TB(1 To TBI)
Ro = .Cells(Ro, i).End(xlDown).Row
TB(TBI) = .Cells(Ro, i).Value
Loop
End With
Next
RR = 1: CC = 1
For Each ttb In TB
If CC > 4 Then
RR = RR + 1
CC = 1
End If
Sheets("Sheet2").Cells(RR, CC).Value = ttb
CC = CC + 1
Next
Erase TB
End Sub
|
|