VBA 相當新。嘗試從每個作業表中的最后一個填充列中獲取填充的單元格并將所有這些值粘貼到一個作業表中 - 在下一個空行上，因此不會覆寫任何值。有以下內容，但將范圍分配給 LastCol 變數有問題。任何指導表示贊賞。
Sub ExtractLastColumn()
Dim ws As Worksheet
Dim sht As Worksheet
Dim wrk As Workbook
Dim LastCol As Range
Dim LastRow As Range
'Create new sheet and combine tabs
Set wrk = ActiveWorkbook 'Working in active workbook
'Add new worksheet as the last worksheet called INSERTS
With ThisWorkbook
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = "INSERTS"
End With
'loop to get values from last column on each worksheets and paste into new INSERTS sheet
For Each sht In wrk.Worksheets
If sht.Name <> "INSERTS" And sht.Name <> ws.Name Then
'get range of populated cells in last populated column
LastCol = Cells(1, Columns.Count).End(xlToLeft).Value
'get next empty row on INSERTS sheet
Worksheets("INSERTS").Activate
LastRow = Cells(Rows.Count, 1).End(xlUp).Row 1
'paste range from sheet into next emtpy row for INSERTS sheet
Worksheets(sht).Range(LastCol).Copy Worksheets("INSERTS").Range(LastRow)
End If
Next sht
End Sub
uj5u.com熱心網友回復：
提取最后一列
Sub ExtractLastColumn()
' Define constants.
Const DESTINATION_WORKSHEET_NAME As String = "INSERTS"
Const DESTINATION_FIRST_CELL_ADDRESS As String = "A2"
' Reference the workbook.
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Application.ScreenUpdating = False
' Delete the destination sheet if it exists.
Dim dsh As Object
Dim dCodeName As String
On Error Resume Next
Set dsh = wb.Sheets(DESTINATION_WORKSHEET_NAME)
On Error GoTo 0
If Not dsh Is Nothing Then
If TypeOf dsh Is Worksheet Then dCodeName = dsh.CodeName
Application.DisplayAlerts = False
dsh.Delete
Application.DisplayAlerts = True
End If
' Write all worksheet names to an array.
Dim wsCount As Long: wsCount = wb.Worksheets.Count
Dim WorksheetNames() As String: ReDim WorksheetNames(1 To wsCount)
Dim sws As Worksheet
Dim n As Long
For Each sws In wb.Worksheets
n = n 1
WorksheetNames(n) = sws.Name
Next sws
' Add a new worksheet, the destination worksheet.
Dim dws As Worksheet
Set dws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
dws.Name = DESTINATION_WORKSHEET_NAME
If Len(dCodeName) > 0 Then
wb.VBProject.VBComponents(dws.CodeName).Name = dCodeName
End If
Dim dfCell As Range: Set dfCell = dws.Range(DESTINATION_FIRST_CELL_ADDRESS)
' Copy the last column from each source worksheet
' to the destination worksheet.
Dim srg As Range
For Each sws In wb.Worksheets(WorksheetNames)
With sws.UsedRange
Set srg = .Columns(.Columns.Count)
End With
srg.Copy dfCell
Set dfCell = dfCell.Offset(srg.Rows.Count)
Next sws
Application.ScreenUpdating = True
' Inform.
MsgBox "Last columns extracted.", vbInformation
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/529611.html
標籤：擅长vba复制