Sheets(nSheet).UsedRange.Copy  '复制到剪贴板
        

Sheets(1).Range("B" & nStartRow).PasteSpecial  '粘贴

Sub aa()
'
' aa Macro
'
   Dim nStartRow
   Dim nRowCount
   Dim strDwmc
   Dim nSheet, nSheetCount
   
   
   nStartRow = 118  '从118行开始
   
   nSheetCount = Sheets.Count
   
   For nSheet = 2 To nSheetCount
   
        nRowCount = Sheets(nSheet).UsedRange.Rows.Count
        strDwmc = Sheets(nSheet).Name
        
        Sheets(nSheet).UsedRange.Copy  '复制到剪贴板
        
        Sheets(1).Range("B" & nStartRow).PasteSpecial  '粘贴
        
        '填写单位名称
        For nRow = 1 To nRowCount
            Sheets(1).Cells(nStartRow + nRow - 1, 4).Value = strDwmc
            
        Next
        
            
      nStartRow = nStartRow + nRowCount + 3 '下一家单位的起始行
        
   Next
   
  
End Sub