|    | 
     ▼UO3 さん: 
 
ご返信有難うございます。 
 ご教授していただいた通り、 
---------------------------------------------------------------------------------  
Private Sub CommandButton1_Click() 
 
  Dim WS1 As Worksheet 
  Dim Tbl As Range 
  Dim v, i As Long, n As Long, n1 As Long 
  Dim myPath As String 
  Dim newBook As Workbook 
  Dim Bookname As String 
  
  Application.DisplayAlerts = False 
  
  myPath = ActiveWorkbook.Path & "\" 
  Set WS1 = ActiveWorkbook.Worksheets("Sheet1") 
   
  Set WS2 = ActiveWorkbook.Worksheets("Sheet2") 'テスト 
 
 
  'Set Tbl = ActiveSheet.[A1].CurrentRegion '◆ A列で Sort済み 
  Set Tbl = WS1.[A1].CurrentRegion '◆ A列で Sort済み 
 
  n = Tbl.Rows.Count 
  v = Tbl.Resize(n + 1, 1).Value 
  n1 = 3    '◆変更 
  For i = 3 To n '◆変更 
    If v(i, 1) <> v(i + 1, 1) Then '下と違えば 
      With Workbooks.Add(xlWBATWorksheet) '◆変更 シート1枚のBook 
        Tbl.Rows("1:2").Copy .Sheets(1).[A1] '◆見出し行2行をCopy 
        Tbl.Rows(n1 & ":" & i).Copy .Sheets(1).[A3] '3行目へ 
         
        Sheets("Sheet1").Range("A10:J30").Value = WS2.Range("A5:J23").Value 'テスト 
 
 
        .Sheets(1).UsedRange.EntireColumn.AutoFit '◆挿入 
 
 
     With ActiveSheet.PageSetup 
     .PrintTitleRows = "$1:$1" 
     .PrintTitleColumns = "" 
     End With 
------------------------------------------------------------------------------------------ 
にて、 「Set WS2 = ActiveWorkbook.Worksheets("Sheet2") 'テスト」 
と「Sheets("Sheet1").Range("A10:J30").Value = WS2.Range("A5:J23").Value 'テスト」 
を追加しましたが、上手くいきません。 
 
やりたい事は例として、 
「Sheet1」 
題名1 
題名2 
りんご \100 
りんご \100 
りんご \100 
バナナ \200 
バナナ \200 
メロン \500 
 
「Sheet2」 
 
-------注意事項----------------- 
冷蔵保存して下さい。 
--------------------------------- 
 
作成されるデータ1. 
題名1 
題名2 
りんご \100 
りんご \100 
りんご \100 
-------注意事項----------------- 
冷蔵保存して下さい。 
--------------------------------- 
 
作成されるデータ2. 
題名1 
題名2 
バナナ \200 
バナナ \200 
-------注意事項----------------- 
冷蔵保存して下さい。 
--------------------------------- 
 
作成されるデータ3. 
題名1 
題名2 
メロン \500 
-------注意事項----------------- 
冷蔵保存して下さい。 
--------------------------------- 
 
としたいと考えております。 
ご教授をお願い致します。 
 
 
>▼VBA初心者 さん: 
> 
>こんにちわ。 
> 
> コードは読んでいないけど、全体的に、元ブックのSheet1以外のシートがどれなのかが 
> ちょっとあいまいなコード記述になっていますね。全て、ちゃんと指定したほうがいいです。 
> 少なくとも、【元ブックのSheet2】は、ちゃんと(WS1のように)設定しておくべき。 
> 
> で、本題。 
> 質問文の中では「B6〜I33」、一方、アップされたコードの中では「B23:E23」。 
> ここはどうなのでしょう? 
> 
> いずれにしても 
>1.Range("B23:E23").Select  '◆テスト 
>2.Selection.Copy      '◆テスト 
>3.Sheets("Sheet1").Select  '◆テスト 
>4.ActiveSheet.Paste     '◆テスト 
> 
> この1.は、今アクティブなブックのアクティブなシートをさしています。 
> で、今、アクティブなブックは、新規に作成するために追加されたブックですよね。 
> それと気になるのは、4. これは新規に作成するブックのSHeet1にペーストするんだけど 
> そのペーストする場所は?たまたまブックを追加してから、セルを動かしてはいないので 
> A1を想定しているのでしょうか? 
> 
> たとえば元ブックのSheet2が WS2 なら 
> 
> WS2.Range("B23:E23").Copy Sheets("SHeet1").range("A1") といったように記述しましょう。 
> 
> 値コピーでいいならコピペじゃなく 
> 
> Sheets("Sheet1").range("A1:D23").value = WS2.Range("B23:E23").Value  
> 
> といった書き方のほうが素直かな? 
> (コピー先のセルは想像でA1にしているけど、ここは実際のものに) 
> 
> ★何をどうしたいのかがわからないので、コードをざっと眺めた上での感想。 
> 勘違いしていたらスルー願います。 
 | 
     
    
   |