vbaでExcelの最初と最後の行を選択してコピーする方法は？

Question

Excelワークシートの最初の3行と最後の行を選択してコピーしたいのですが、コードの下の行Selection.Copyにエラーがあります。

Sub SaveLastLine() 
    Dim WB As Workbook, filename As String 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 

    Range("B1").Select 
    Selection.End(xlDown).Select 
    Union(Range("1:3"), Range(Selection, Selection.End(xlToRight))).Select 

    Selection.Copy 
    Workbooks.Add 
    ActiveSheet.Paste 
End Sub 

誰でも教えてください。

Answer 1

は、おそらくあなたの問題です： あなたのデータは「B1」で始まることを考慮し、新しいワークシートが4行を持っているだろうことを考えると、私はあなたのコードにいくつかの変更を行いました。 Kellsensは最初に最初の3行をコピーし、最後の行を新しいワークシートにコピーすることで、この問題を回避するソリューションを提供しました。

これをすべてワンショットで実行する場合は、まず範囲を定義してから、その範囲の内容を新しいブックにコピーします。このようなもの：

Sub SaveLastLine() 

    Dim WB As Workbook 
    Dim myRange As Range 

    'copy the content 
     Set myRange = Union(Range(Range("B1:B3"), Range("B1:B3").End(xlToRight)), _ 
          Range(Range("B1").End(xlDown), Range("B1").End(xlDown).End(xlToRight))) 
     myRange.Copy 

    'paste the content 
     Set WB = Workbooks.Add 
     WB.ActiveSheet.Range("A1").PasteSpecial 

End Sub 

Answer 2

新しいブックを作成するときに貼り付けるアクティビティシートがない場合、それがエラーの原因です。新しいワークブックを宣言された変数Wbにインスタンス化することができます。選択された範囲での作業

Sub SaveLastLine() 
    Dim wb As Workbook 
    Dim ws As Worksheet 
    Dim filename As String 
    Dim lastCol As Integer 
    Dim lastRow As Integer 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 

    Set ws = ActiveSheet ' Here I instantiate the active worksheet 
    Set wb = Workbooks.Add ' Here I instantiate the new workbook 

    lastCol = ws.Range("B1").End(xlToRight).Column 
    lastRow = ws.Range("B1").End(xlDown).Row 

    ws.Range(ws.Cells(1, 2), ws.Cells(3, lastCol)).Copy wb.Worksheets(1).Range("B1") ' Here I copy the first 3 rows and paste in the first worksheet of your new workbook 
    ws.Range(ws.Cells(lastRow, 2), ws.Cells(lastRow, lastCol)).Copy wb.Worksheets(1).Range("B4") ' Here I copy the last row and paste 

    filename = "yourfilename.xlsx" 
    wb.SaveAs filename 

    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 

End Sub