如何將從不同工作表橫向放置的相同列複製到單個工作表中？

Question

我在工作簿中有50個工作表。列a，b，c，d與列e，f，g，h相同，但是這兩個集合可能具有不同數量的行/觀察值。我需要將所有內容整合到只有3列的單張紙上。我需要追加列名，從第3行開始複製和粘貼（值）（直到數據結束）。我也嘗試過錄制宏，但在這種情況下，我必須手動完成所有的工作表。有人能帶領我走向正確的方向嗎？我對VBA很陌生，有一點幫助會很感激。我記錄的宏複製2張是這樣的：

Sheets("page 9").Select 
Range("A3:D3").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 
ActiveWindow.ScrollWorkbookTabs Position:=xlLast 
Sheets.Add After:=Sheets(Sheets.Count) 
Range("A2").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Selection.End(xlDown).Select 
Range("A67").Select 
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst 
Sheets("page 9").Select 
Range("E3:H3").Select 
Range(Selection, Selection.End(xlDown)).Select 
Application.CutCopyMode = False 
Selection.Copy 
ActiveWindow.ScrollWorkbookTabs Position:=xlLast 
Sheets("Sheet1").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Selection.End(xlDown).Select 
Range("A132").Select 
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst 
Sheets("page 10").Select 
Range("A65").Select 
Selection.End(xlUp).Select 
Range("A3:D3").Select 
Range(Selection, Selection.End(xlDown)).Select 
Application.CutCopyMode = False 
Selection.Copy 
ActiveWindow.ScrollWorkbookTabs Position:=xlLast 
Sheets("Sheet1").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Selection.End(xlDown).Select 
Range("A197").Select 
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst 
Sheets("page 10").Select 
Range("E3:H3").Select 
Range(Selection, Selection.End(xlDown)).Select 
Application.CutCopyMode = False 
Selection.Copy 
ActiveWindow.ScrollWorkbookTabs Position:=xlLast 
Sheets("Sheet1").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Selection.End(xlUp).Select 
Range("A1").Select 
Application.CutCopyMode = False 
ActiveCell.FormulaR1C1 = "Date" 
Range("B1").Select 
ActiveCell.FormulaR1C1 = "Type" 
Range("C1").Select 
ActiveCell.FormulaR1C1 = "Size" 
Range("D1").Select 
ActiveCell.FormulaR1C1 = "Discount" 
Range("A1").Select 
End Sub 

Answer 1

我懷疑任何人都可以decypher此代碼;當然，我缺乏這種能力。

宏錄製是學習的新命令語法的一個好辦法，但它不會產生「好」的代碼。它不知道你的目標，並記錄下你的每一步。

花時間研究的Excel VBA的時間。在Internet上搜索「Excel VBA教程」或訪問一個好的圖書館或書店，然後選擇一個Excel VBA入門。有很多選擇，所以我相信你會找到適合你的學習風格的東西。這項研究將迅速償還您的投資。

通過看StackOverflow上的Excel的VBA的問題。很多，也許大部分，都不會對你有任何興趣。但有些人會展示你不知道的技術，但是這些技術會很有用。也許學習VBA最困難的方面是發現什麼是可能的。一旦你知道語句X存在，你可以查看它並研究它的語法和功能。

下面是4個宏演示相關的代碼。將它們複製到工作簿並嘗試它們。你無法從宏觀記錄器輸出的研究中學會如何編寫這些宏。

一個這個宏輸出每一個工作表到立即窗口的名稱。

Sub A() 

    Dim InxWsht As Long 

    For InxWsht = 1 To Worksheets.Count 
    Debug.Print Worksheets(InxWsht).Name 
    Next 

End Sub 

乙這在當前列表並將其命名爲「整合」末增加了一個新的工作表。然後它會創建一個粗體的彩色標題行。

Range(CellId).Value是訪問一個單元格的值的一種方式。我已經使用"A1"作爲單元格的Id，但這只是一個字符串，可能在運行時已經生成。 Cells(RowId, ColId).Value是另一種方式。 RowId必須是數字或整數變量。 ColId可以是數字，整數變量或列字母。我建議你保持一致，不要像我一樣混搭。

我顯示指定一個範圍，所以我可以設置整個標題行粗體和在單個語句着色兩種方法。

如果我寫Range("A1").Value = "Date"此聲明將活動工作表中的單元格A1已運行。 Range之前的.表示此語句對With語句中標識的工作表的單元格A1進行操作。使用With意味着我不必切換工作表使用Select這是一個緩慢的命令。

Sub B() 

    Dim WhshtCons As Worksheet 

    Set WhshtCons = Sheets.Add(After:=Sheets(Sheets.Count)) 

    WhshtCons.Name = "Consolidate" 

    With WhshtCons 

    .Range("A1").Value = "Date" 
    .Cells(1, 2).Value = "Type" 
    .Cells(1, "C").Value = "Size" 
    .Cells(1, 4).Value = "Discount" 

    .Range("A1:D1").Font.Bold = True 
    .Range(.Cells(1, 1), .Cells(1, "D")).Font.Color = RGB(0, 128, 128) 

    End With 

End Sub 

Ç此輸出除外「整合」的每一個工作表的單元格A1的值。

Sub C() 

    Dim InxWsht As Long 

    For InxWsht = 1 To Worksheets.Count 
    If Worksheets(InxWsht).Name <> "Consolidate" Then 
     With Worksheets(InxWsht) 
     Debug.Print "Cell A1 of Worksheet " & .Name & " contains [" & _ 
        .Cells(1, 1).Value & "]" 
     End With 
    End If 
    Next 

End Sub 

d，因爲它一定程度上比其他人更高級的我就不解釋了這個宏。它演示從所有其他工作表中移動數據列到工作表「合併」。我懷疑這與你所尋求的接近，但它表明你所尋求的是可能的。

Sub D() 

    Dim ColConsCrnt As Long 
    Dim InxWsht As Long 
    Dim RowLast As Long 
    Dim WhshtCons As Worksheet 

    ColConsCrnt = 1 

    Set WhshtCons = Worksheets("Consolidate") 
    WhshtCons.Cells.EntireRow.Delete 

    For InxWsht = 1 To Worksheets.Count 
    If Worksheets(InxWsht).Name <> "Consolidate" Then 
     With Worksheets(InxWsht) 
     RowLast = .Cells(Rows.Count, "A").End(xlUp).Row 
     WhshtCons.Cells(1, ColConsCrnt).Value = .Name 
     .Range(.Cells(1, "A"), .Cells(RowLast, "A")).Copy _ 
          Destination:=WhshtCons.Cells(2, ColConsCrnt) 
     End With 
     ColConsCrnt = ColConsCrnt + 1 
    End If 
    Next 

End Sub 

歡迎使用編程。我希望你能像我一樣樂在其中。