初期範囲と行先範囲を変更する

Question

私はExcel vbaの初心者ですが、Siddharth Rout（感謝）からマクロを変更しようとしています。

セルで開始する範囲をB13のように指定し、C14で別のワークシートにコピーする必要があります。 これはどのように管理できますか？

ありがとうございます。

Option Explicit 

Sub Sample() 
Dim lastRow As Long, i As Long 
Dim CopyRange As Range 

'~~> Change Sheet1 to relevant sheet name 
With Sheets("Sheet1") 
    lastRow = .Range("A" & .Rows.Count).End(xlUp).Row 

    For i = 2 To lastRow 
     If Len(Trim(.Range("A" & i).Value)) <> 0 Then 
      If CopyRange Is Nothing Then 
       Set CopyRange = .Rows(i) 
      Else 
       Set CopyRange = Union(CopyRange, .Rows(i)) 
      End If 
     End If 
    Next 

    If Not CopyRange Is Nothing Then 
     '~~> Change Sheet2 to relevant sheet name 
     CopyRange.Copy 
     Sheets("Sheet2").Rows(1).PasteSpecial xlValues 
    End If 
End With 
End Sub 

Answer 1

CopyRangeであるため、完全な行が広いあなたがRange("B13")に貼り付ける前に、それをトリミングする必要があります。追加要件として、OPはソース範囲から列Aを除外したい。

Sub Sample() 
    Dim lastRow As Long, i As Long 
    Dim CopyRange As Range 

    '~~> Change Sheet1 to relevant sheet name 
    With Sheets("Sheet1") 
     lastRow = .Range("A" & .Rows.Count).End(xlUp).Row 

     For i = 2 To lastRow 
      If Len(Trim(.Range("A" & i).Value)) <> 0 Then 
       If CopyRange Is Nothing Then 
        Set CopyRange = .Rows(i) 
       Else 
        Set CopyRange = Union(CopyRange, .Rows(i)) 
       End If 
      End If 
     Next 

     If Not CopyRange Is Nothing Then 
      '~~> Change Sheet2 to relevant sheet name 
      Intersect(Sheets("Sheet1").UsedRange, CopyRange).Offset(0, 1).Copy 
      Sheets("Sheet2").Range("B13").PasteSpecial xlValues 
     End If 
    End With 
End Sub