'Copy columns to next available row
I am looking to paste the columns from the source worksheet 'Model' to the next available row in the destination worksheet 'summary'. Currently it pastes to row 10 but this will be a repetitive task so it would be good to automate it further. Any help would be much appreciated thanks
Sub MyCopy()
Dim myCols As Variant
Dim lastRow As Long
Dim c As Long
myCols = Array("W", "J", "D")
For c = LBound(myCols) To UBound(myCols)
lastRow = Sheets("Model").Cells(Rows.Count, myCols(c)).End(xlUp).Row
Sheets("Model").Range(Cells(2, myCols(c)), Cells(lastRow, myCols(c))).Copy
Sheets("Summary").Cells(10, c + 1).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Next c
Sheets("Summary").Activate
End Sub
Solution 1:[1]
Copy Columns to Another Worksheet
Option Explicit
Sub CopyColumns()
Const sName As String = "Model"
Const sfRow As Long = 2
Dim sCols As Variant: sCols = VBA.Array("W", "J", "D")
Const dName As String = "Summary"
Const dfRow As Long = 10
Dim dCols As Variant: dCols = VBA.Array("A", "B", "C")
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim wsrCount As Long: wsrCount = sws.Rows.Count
Dim nUpper As Long: nUpper = UBound(sCols)
Dim slRow As Long
Dim dlRow As Long
Dim n As Long
Dim r As Long
For n = 0 To nUpper
r = sws.Cells(wsrCount, sCols(n)).End(xlUp).Row
If slRow < r Then slRow = r
r = dws.Cells(wsrCount, dCols(n)).End(xlUp).Row
If dlRow < r Then dlRow = r
Next n
If dlRow < dfRow Then
dlRow = dfRow
Else
dlRow = dlRow + 1
End If
Dim rCount As Long: rCount = slRow - sfRow + 1
For n = 0 To nUpper
dws.Cells(dlRow, dCols(n)).Resize(rCount).Value _
= sws.Cells(sfRow, sCols(n)).Resize(rCount).Value
Next n
dws.Activate
MsgBox "Columns copied.", vbInformation
End Sub
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|---|
| Solution 1 | VBasic2008 |
