在excel中合并表格

我有一个工作簿，里面有50张表格。 我所要做的是将所有表单合并到一个主表单中，使用以下条件：1.每个表单在其自己的列中2.表单名称作为该列的表头

每张纸都有一列（A），里面有数据，但有不同数量的行。 表单中没有标题。 从我的研究中，我发现我可以将所有的工作表合并成一列，但这没有帮助。 任何帮助将不胜感激，谢谢

Answer 1

这有点丑，但它会做你想要的。 只需将Set targetWS = Sheets("Sheet1")设置为您要放置所有数据的工作表。

 Sub combineSheets() Dim sourceWs As Worksheet Dim targetWs As Worksheet Dim targetCol As Integer Dim endRow As Long 'This is the sheet where the data will end up Set targetWs = Sheets("Sheet1") 'This is the first column to start pasting into targetCol = 1 'Loop through the worksheets in the workbook For Each sourceWs In ThisWorkbook.Worksheets 'grab the data from each sheet, bu not the target sheet If sourceWs.Name <> targetWs.Name Then 'find last row in source sheet endRow = sourceWs.Range("A999999").End(xlUp).Row() 'paste data and name targetWs.Range(targetWs.Cells(2, targetCol), targetWs.Cells(endRow, targetCol)) = sourceWs.Range("A1:A" & endRow).Value targetWs.Cells(1, targetCol).Value = sourceWs.Name 'next column targetCol = targetCol + 1 End If Next sourceWs End Sub 

Answer 2

尝试这个：

 Dim J As Integer On Error Resume Next Sheets(1).Select Worksheets.Add Sheets(1).Name = "Combined" Sheets(2).Activate Range("A1").EntireRow.Select Selection.Copy Destination:=Sheets(1).Range("A1") For J = 2 To Sheets.Count Sheets(J).Activate Range("A1").Select Selection.CurrentRegion.Select Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) Next 

它会帮助你..

Answer 3

这可能有帮助

 Option Explicit Sub CopyRangePaste() 'copies and pastes what is required Dim wshResult As Worksheet Dim wsh As Worksheet Dim msg As String ' alert message Dim iCounter As Integer If Worksheets.Count < 2 Then 'if there is only 1 worksheet exits sub msg = "There is only 1 worksheet." & vbCrLf msg = msg & "Try again with a different workbook." MsgBox msg, vbCritical Exit Sub End If Set wshResult = ActiveWorkbook.Sheets.Add iCounter = 0 For Each wsh In ActiveWorkbook.Worksheets If wsh.Name <> wshResult.Name Then 'checks if the newly created sheet is not operated on iCounter = iCounter + 1 wshResult.Cells(1, iCounter) = wsh.Name wsh.Range(wsh.UsedRange.Find("*").CurrentRegion.Address).Copy _ wshResult.Cells(2, iCounter) 'copies the current region End If Next wsh MsgBox iCounter & " sheets" End Sub