特定の範囲のセルを30枚から1枚に自動コピーする方法。

Question

私は毎月30枚のシートを持っています。それぞれに異なるデータを持つ同じ列があります（A1：A30の範囲）。だから、私の仕事は、すべてのシートからこの範囲をコピーして、隣接する異なる列の1つのマスターシートにコピーすることです。 A1：A30、B1：B30、C1：C30などがある。

Answer 1

これは、コピーのための一般的なコードでは、範囲：

Sub Copy_ranges() 

    Dim NS As Worksheet 

    Application.ScreenUpdating = False 
    Application.EnableEvents = False 

    Set NS = Sheets.Add 

    i = 1 
    refRange = "A1:D10" 

    For Each sht In Worksheets 
     If (sht.Name <> NS.Name) Then 
     Set SheetRange = sht.Range(Right(refRange, Len(refRange) - InStr(refRange, "!"))) 
     SheetRange.Copy 
     NS.Cells(i, 1).Value = sht.Name 
     NS.Cells(i, 2).PasteSpecial xlPasteValues 
     i = i + SheetRange.Rows.Count 
     End If 
    Next sht 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 

End Sub 

あなたは、あなたのニーズに合わせて、あなたの範囲とペーストサイクルにrefRangeを変更することがあります。

Sub Copy_ranges() 

    Dim NS As Worksheet 

    Application.ScreenUpdating = False 
    Application.EnableEvents = False 

    Set NS = Sheets.Add 

    i = 1 
    refRange = "A1:A10" 

    For Each sht In Worksheets 
     If (sht.Name <> NS.Name) Then 
      Set SheetRange = sht.Range(Right(refRange, Len(refRange) - InStr(refRange, "!"))) 
      SheetRange.Copy 
      NS.Cells(1, i).Value = sht.Name 
      NS.Cells(2, i).PasteSpecial xlPasteValues 
      i = i + SheetRange.Columns.Count 
     End If 
    Next sht 

    Application.ScreenUpdating = True 
    Application.EnableEvents = True 

End Sub 

Answer 2

ダウンロードして、このアドインをインストールします。

あなたが何をしているかのあなたのための仕事だけでなく、他の多くの変形を行います https://www.rondebruin.nl/win/addins/rdbmerge.htm

。