VBA从列（B到G）复制和粘贴循环到A列的最后一行答案

【问题标题】：VBA copy & Paste loop from columns (B to G) to the last row of column AVBA从列（B到G）复制和粘贴循环到A列的最后一行
【发布时间】：2021-03-19 03:42:20
【问题描述】：

我需要您的帮助来创建用于复制循环的 VBA。

我想将 B 列中的一系列数据复制到 A 列的最后一行，然后将下一列 C 复制到 A 列的最后一行。

【问题讨论】：

标签： excel vba for-loop

【解决方案1】：

堆叠列

Option Explicit

Sub stackColumns()
    
    Const sCols As String = "B:G" ' Source Columns
    Const sFirst As Long = 1 ' Source First Row
    Const dCol As String = "A" ' Destination Column
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' adjust here
    
    Dim srg As Range: Set srg = ws.Columns(sCols)
    Dim dCell As Range: Set dCell = ws.Cells(ws.Rows.Count, dCol).End(xlUp)
    If Not IsEmpty(dCell) Then
        Set dCell = dCell.Offset(1)
    End If
    
    Dim crg As Range
    Dim crCount As Long
    Dim j As Long
    For j = 1 To srg.Columns.Count
        With srg.Columns(j)
            crCount = .Cells(.Rows.Count).End(xlUp).Row - sFirst + 1
            Set crg = .Resize(crCount).Offset(sFirst - 1)
        End With
        dCell.Resize(crCount).Value = crg.Value
        Set dCell = dCell.Offset(crCount)
    Next j

End Sub

【讨论】：

嗨，谢谢，尽管我通过使用宏 Sub Macro1() ' ' Macro1 Macro Dim x As Integer For x = 1 To 113 Range("C1") 想出了一个更短的版本.Select Selection.End(xlToRight).Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste Next x End Sub