如何用VBA語言同一EXCEL中不同sheet中的列數據按列順序導入到一個sheet中去?

01-29

如圖所示，圖一和圖二是原始的數據表，圖三是預期結果。
即：一個Excel中有多個sheet，需要將每個sheet（除了第一個）中的每一列數據（除了第一列），按照列和 sheet的排列順序合併到一個新建的工作表中
本人小白，基本沒有VB經驗

既然施主如此堅持, 老衲就來獻醜了.

先說思路:

1. 遍歷除第一個sheet之外的每一個sheet

2. 在某sheet中, 將除第一列之外的內容複製. 這個地方其實不太好處理, 因為要確定有數據區域的邊界需要比較低效的代碼. 幸虧Excel自己提供了相應的方法. 否則又得套一層循環.

3. 回到sheet1, 將內容黏貼到sheet1中, 並返回最後一列的坐標

4. 進入下一個sheet, 將除一列之外的內容複製

5. 回到sheet1中, 將內容根據步驟3返回的坐標, 將內容順序黏貼到sheet1中.

重複直至結束.

先處理在兩個sheet之間如何copy + paste的問題, 順帶傳個坐標

Move content to another sheet and return the coordinate next round Public Function moveContentBetweenSheets(sheetStartPoint As Worksheet, sheetDestination As Worksheet, columnCoordinate As Integer) As Integer


    find out the last used cell to locate the whole data area

    Dim tempRange As Range

    Set tempRange = sheetStartPoint.Cells.SpecialCells(xlCellTypeLastCell).Cells
    Copy all data from the sheet except for the first column. Warning: I did not test it here. Its not able to handle all cases.

    Range(sheetStartPoint.Range("B1"), tempRange).Copy
    set an anchor. Note: Its hard code here. Must be the first row of given column.

    sheetDestination.Cells(1, columnCoordinate).Select

    Paste the data to the given area (selected area)

    sheetDestination.Paste
    Return the coordinate for the next round

    moveContentBetweenSheets = (Range(sheetDestination.Range("A1"), sheetDestination.Cells.SpecialCells(xlCellTypeLastCell)).Columns.Count) + 1

End Function

然後調用這個函數

Public Sub copyContentToFirstSheet()


Dim anchor As Integer

anchor = 0
Jump over the first sheet, so the index begins with 2

For i = 2 To ActiveWorkbook.Worksheets.Count

    If anchor = 0 Then

        anchor = moveContentBetweenSheets(ActiveWorkbook.Worksheets(i), ActiveWorkbook.Worksheets(1), 1) Note: Its hard code here. All content will be pasted to the first sheet

    Else

        anchor = moveContentBetweenSheets(ActiveWorkbook.Worksheets(i), ActiveWorkbook.Worksheets(1), anchor)

    End If

Next

End Sub

解決. 如果代碼有bug就麻煩自己修改一下~~~

基本流程在我的office 2013上可以走通:

使用說明：

將所有 Sheet 名不等於活動 Sheet 的 Sheet 從 B 列開始匯總至活動 Sheet
按照 Sheet 順序（非 Sheet 名順序）排序
所有 Sheet 的首行需有連續標題，否則可能被忽略
支持新建 Sheet 匯總

效果圖示：

新建 Sheet 後使用

代碼如下：

Sub GatherColumnsExceptA_BySheet() Version 1.0 By 餅乾 Dim AimSht As Worksheet, isht As Worksheet Set AimSht = ActiveSheet For Each isht In ThisWorkbook.Worksheets With isht If .Name &<&> AimSht.Name And .[B1] &<&> "" Then .Range(.Cells(1, 2), .Cells(1, 2).End(xlToRight).End(xlToRight).End(xlToLeft)).EntireColumn.Copy If AimSht.[A1] = "" Then AimSht.Cells(1, 1).PasteSpecial Paste:=xlPasteValues Else AimSht.Cells(1, 1).End(xlToRight).End(xlToRight).End(xlToLeft).Offset(, 1).PasteSpecial Paste:=xlPasteValues End If End If End With Next isht End Sub

Fin

我理解的不太一樣呃~

Sub sheetConcatenate()


Dim tempArr

For i = 2 To Worksheets.Count

  tempArr = Worksheets(i).UsedRange.Offset(, 1)

  Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(UBound(tempArr), UBound(tempArr, 2)).Value = tempArr

Next i

End Sub

我想的是這樣子的

把後面sheet的內容匯總在第一個表裡

去excelhome搜一下就有了