如何使Excel VBA循環直到到達數據結尾

Question

我是VBA的新手，非常感謝您的幫助。 作為研究的一部分，我需要使正在執行的任務自動化。

我有兩本工作簿，一本包含多個電子表格（一個用於每個聲音測量，其名稱為Matlab Contours_Extracted_20170815.xlsx），另一本需要在其中合並第一個電子表格的每個電子表格的第一列（稱為Mat-lab）輪廓合並（xlx）。

我設法達到了自動的一對一的復制和粘貼過程，並且可以正常工作，但是我希望它一直運行到文檔末尾（並且不是一定數量的紙張）。

以下是我擁有的代碼，這是我的問題：

1. 如何循環播放，使其遍歷所有電子表格，直至其結束？

2. 如何使它從第一個開始（我有它，但是現在我丟失了，它直接跳到Sheet + 1）。 這不是一個大問題，但會很有幫助。

3. 最后，如何使光標停留在第一行的最后一個空單元格而不是第一行？ 在這種情況下，我故意放入1,1，因為我試圖將其放在最后並失敗了。 但我最后還是希望。 :)

我將不勝感激任何人的幫助！ 非常感謝！ :)

這是代碼：

Windows("Matlab Contours_Extracted_20170815.xlsx").Activate
Columns("A:A").Select
Selection.Copy
Windows("Matlab Contours consolidated.xlsx").Activate
Selection.ColumnWidth = 12.17
c = Cells(1, 1).End(xlToRight).Column + 1
Cells(1, c).Select
ActiveSheet.Paste
Windows("Matlab Contours_Extracted_20170815.xlsx").Activate
Sheets(ActiveSheet.Index + 1).Activate
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Matlab Contours consolidated.xlsx").Activate
ActiveSheet.Paste
Selection.ColumnWidth = 14.17
Rows("1:1").Select
Application.CutCopyMode = False
With Selection
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .MergeCells = False
End With
Range("A1").Select
End Sub

Answer 1

你可以試試這個：

Sub Matlab_Copy_Paste()

Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim i As Integer
Dim a As Integer

Set Wb1 = Workbooks("Matlab Contours_Extracted_20170815.xlsx") 'Adapt to your origin workbook
Set Wb2 = Workbooks("Matlab Contours consolidated.xlsm") 'Adapt to your destination workbook
a = 1

For i = 1 To Wb1.Sheets.Count
    Wb1.Sheets(i).Range("A1:A" & Wb1.Sheets(i).Range("A999999").End(xlUp).Row).Copy Wb2.Sheets(1).Cells(1, a)
    a = a + 1
Next i

Wb2.Sheets(1).Range("XFD1").End(xlToLeft).Offset(0, 1).Select

'Edit for transpose result
T1 = Wb2.Sheets(1).UsedRange
Wb2.Sheets(1).Cells.Clear
Wb2.Sheets(1).Range("A1").Resize(UBound(T1, 2), UBound(T1, 1)) = Application.Transpose(T1)
'End of edit for transpose result

End Sub

不知道您是否真的想將它並排粘貼在...