| |
こんにちは
Sub test()
Dim r As Range
Dim v As Variant
Dim e As Long
Dim s As Range
Dim t As Range
Dim a As Worksheet
Dim b As Worksheet
Set a = Worksheets("Sheet1") 'データの有るシート
e = a.Range("B" & Rows.Count).End(xlUp).Row
If e < 7 Then Exit Sub
Application.ScreenUpdating = False
For Each r In a.Range("B1:B" & e)
If IsNumeric(r) = False Then
If r <> "" Then
If r <> v Then
If IsEmpty(v) = False Then
Set t = r.Offset(-1)
Set b = Worksheets.Add(After:=ActiveSheet)
b.Name = v
a.Range(s, t).EntireRow.Copy b.Range("A1")
Set s = r
Else
Set s = r
End If
v = r.Value
Else
v = r.Value
If s Is Nothing Then
Set s = r
End If
End If
End If
End If
Next
Set b = Worksheets.Add(After:=ActiveSheet)
b.Name = v
a.Range(s, a.Range("B" & e)).EntireRow.Copy b.Range("A1")
Application.ScreenUpdating = True
End Sub
こんな感じで動きますか？
B列のデータが店名と数値で判別出来る事が前提です。
▼藁にもすがりたい者 さん：
>▼ウッシ さん：
>
>おはようございます。
>説明が足りずすみません。
>
>店舗の一覧はなくできればコピーしたものを貼り付ける際に
>マクロにて店舗名でシートを作成し、そのシートに貼付ができればと思っておりました。
>
>このような回答で大丈夫でしたでしょうか
>
>
>>こんにちは
>>
>>店舗12店舗の一覧はどこかのシートに有りますか？
>>
>>マクロの中で記述しますか？
>>
>>
>>▼藁にもすがりたい者 さん：
>>>業務上、必要なデータがPDFで送られてくる為
>>>データの加工ができずなんとか方法がないかと模索しています。
>>>
>>>PDFのデータをコピーしてエクセルに貼り付けた状態が以下のとおりです。
>>>
>>> A B C D E F G H I
>>> 1 文字
>>> 2 文字
>>> 3 文字
>>> 4 文字
>>> 5 数値
>>> 6 数値 店名A 数値 数値 数値 数値 数値 数値 数値
>>> 7 数値 数値 数値 科目 金額 消費税
>>> 8 数値 数値 数値 科目 金額 消費税
>>> 9 数値 数値 数値 科目 金額 消費税
>>>10 数値 数値 数値 科目 金額 消費税
>>> .
>>> .
>>> .
>>> .
>>>50 数値 店名A 数値 数値 数値 数値 数値 数値 数値
>>>51 数値 数値 数値 科目 金額 消費税
>>>52 数値 数値 数値 科目 金額 消費税
>>> .
>>> .
>>> .
>>> .
>>>90 数値 店名B 数値 数値 数値 数値 数値 数値 数値
>>>91 数値 数値 数値 科目 金額 消費税
>>>92 数値 数値 数値 科目 金額 消費税
>>> .
>>> .
>>> .
>>> .
>>>
>>>
>>>やりたいことは店名Aと店名Bの間にある行をコピーして
>>>店名Aのシートに貼り付けをしたいのです。
>>>ただ、1店舗につきPDFが2〜3ページあり
>>>上記のように店名Aが2ページあると店名Bまでに店名Aが2回出てきてしまい
>>>これをマクロでどう処理すればよいかわからず…
>>>また店舗は全部で12店舗あり、店名Lまであります。
>>>
>>>マクロについてもつい最近知った程度で
>>>コードなど勉強中の身です…
>>>ただ、この作業を効率化することが急務であり
>>>今回、こちらのサイトにたどり着き、藁にもすがる思いでございます。
>>>
>>>どなたかお力添えを頂けないでしょうか…
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
