VBA: Copy column data and paste it on the next available blank cell

Usually_Wrong

New Member
Joined
Oct 6, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
  2. Web
Hello!

So I'm hoping to do a couple of things on this workbook. I'm going to try and be as clear as I can, but please bear with me.

Task #1: Copy a specific column and paste it at the very bottom of the table. In this scenario, the first column I'd like to do this with is Column A. Copy paste values from column A and add it to the very bottom of the table - still located in column A.

VBA Code:
Sub CopyPaste()
        Range("Table1[Employee ID]").Copy
    Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Sub

Finished product once the macro is run -
1633559923322.png



Task #2: Do the same thing for columns C and E.
At this point, this is where I'm drawing a blank. I would like to copy the data from Column C, paste it under C11, and do the same for column E. However, if I use the formula from above, it makes it so that the copied values on column C are instead pasted on C20, the last available row - column E's copied data would then be pasted after the column C data.

I tried to search for solutions, but I don't believe I've come across it just yet.

The hope is I get a final product like this -
1633561206093.png
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
I can understand what you did in column A and E but not what happened in column C.
Where did 44228 come from?
 
Upvote 0
I can understand what you did in column A and E but not what happened in column C.
Where did 44228 come from?
Sorry, I just realized a little too late that the formatting is off. Somehow, the short date did not carry over. C11:C19 should have the same data as C2:C10. Essentially, the total number of rows should only be up to 19.

Here's what I'm getting with the current formula since it's not all copy pasting at "the same time."

1633581928413.png
 
Upvote 0
I am sure someone can give you a shorter way of doing this but in the meantime try this:

VBA Code:
Sub CopyPaste()
    
    Dim TableName As String
    Dim LastRow As Long
    Dim FirstRow As Long
    Dim NoOfDataRows As Long
    Dim rngToCopy As Range
    
    TableName = "Table1"

    FirstRow = ActiveSheet.ListObjects(TableName).ListColumns("Employee ID").DataBodyRange.Cells(1, 1).Row
    
    LastRow = ActiveSheet.ListObjects(TableName).ListColumns("Employee ID").Range.Find( _
               What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
               
    NoOfDataRows = LastRow - FirstRow + 1
               
    Set rngToCopy = ActiveSheet.ListObjects(TableName).ListColumns("Employee ID").DataBodyRange.Cells(1, 1).Resize(NoOfDataRows)
    rngToCopy.Offset(NoOfDataRows).Value = rngToCopy.Value
    
    Set rngToCopy = ActiveSheet.ListObjects(TableName).ListColumns("Date Hired").DataBodyRange.Cells(1, 1).Resize(NoOfDataRows)
    rngToCopy.Offset(NoOfDataRows).Value = rngToCopy.Value
    
    Set rngToCopy = ActiveSheet.ListObjects(TableName).ListColumns("Emp Code").DataBodyRange.Cells(1, 1).Resize(NoOfDataRows)
    rngToCopy.Offset(NoOfDataRows).Value = rngToCopy.Value
               
               
End Sub
 
Upvote 0
Hello !​
I am sure someone can give you a shorter way
VBA Code:
Sub Demo1()
        Dim C%
    With [A1].CurrentRegion.Columns
        For C = 1 To 5 Step 2:  .Item(C).Copy Cells(.Rows.Count + 1, C):  Next
    End With
End Sub
 
Upvote 0

Forget my previous post ! I will come back with a better demonstration …​
 
Upvote 0
I am sure someone can give you a shorter way
Like a Mandalorian this is the way :​
VBA Code:
Sub Demo2()
        Dim R&, C%
    With [Sheet1!A1].ListObject
            R = .Range.Rows.Count
        For C = 1 To 5 Step 2
           .Range(R, C)(2).Resize(R - 1).Value = .DataBodyRange.Columns(C).Value
        Next
    End With
End Sub
 
Upvote 0
Solution
@Marc L
I kind of liked your first version with a couple of modifications.
It was picking up the heading hence an offset and resize.
And the destination Cells needed context so needed to be .Cells (dot cells) - without the dot it only worked if the table was positioned in A1.

What I liked about this one is that CurrentRegion didn't pick up any blank rows that are within the table boundary.
I half expected it to still pick up the whole table.
Your second version does not exclude blank rows at the bottom of the table and includes them in the copy paste.

Your first version with the changes
VBA Code:
Sub Demo1_MarcL()
    Dim C%
    With [A1].CurrentRegion.Columns
        For C = 1 To 5 Step 2:  .Item(C).Offset(1).Resize(.Rows.Count - 1, 1).Copy .Cells(.Rows.Count + 1, C): Next
    End With
End Sub

My test data below
Note: I ran the code after changing A1 to B4

20211007 VBA Table Last and First Data Row copy range.xlsm
ABCDEFG
1
2
3
4Employee IDJob TitleDate HiredNext EvalEmp Code
51Row 17/10/2021Row Row Row 1Emp Cd 1
62Row 28/10/2021Row Row Row 2Emp Cd 2
73Row 39/10/2021Row Row Row 3Emp Cd 3
84Row 410/10/2021Row Row Row 4Emp Cd 4
95Row 511/10/2021Row Row Row 5Emp Cd 5
106Row 612/10/2021Row Row Row 6Emp Cd 6
117Row 713/10/2021Row Row Row 7Emp Cd 7
128Row 814/10/2021Row Row Row 8Emp Cd 8
13
14
15
Sheet1
 
Upvote 0
And the destination Cells needed context so needed to be .Cells (dot cells) - without the dot it only worked if the table was positioned in A1.
As the dot does not matter here as according to the initial post poor pictures the table starts in cell A1 and assuming it's the active worksheet …​
Of course the dot is necessary in your case starting in cell B4.​
Your second version does not exclude blank rows at the bottom of the table and includes them in the copy paste.
Yes again according to the initial post first poor picture showing the results for column A only so without any blank row in the table initial state,​
the same without any blank row according to the second poor picture as the expected result …​
 
Last edited:
Upvote 0
I am sure someone can give you a shorter way of doing this but in the meantime try this:

VBA Code:
Sub CopyPaste()
   
    Dim TableName As String
    Dim LastRow As Long
    Dim FirstRow As Long
    Dim NoOfDataRows As Long
    Dim rngToCopy As Range
   
    TableName = "Table1"

    FirstRow = ActiveSheet.ListObjects(TableName).ListColumns("Employee ID").DataBodyRange.Cells(1, 1).Row
   
    LastRow = ActiveSheet.ListObjects(TableName).ListColumns("Employee ID").Range.Find( _
               What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
              
    NoOfDataRows = LastRow - FirstRow + 1
              
    Set rngToCopy = ActiveSheet.ListObjects(TableName).ListColumns("Employee ID").DataBodyRange.Cells(1, 1).Resize(NoOfDataRows)
    rngToCopy.Offset(NoOfDataRows).Value = rngToCopy.Value
   
    Set rngToCopy = ActiveSheet.ListObjects(TableName).ListColumns("Date Hired").DataBodyRange.Cells(1, 1).Resize(NoOfDataRows)
    rngToCopy.Offset(NoOfDataRows).Value = rngToCopy.Value
   
    Set rngToCopy = ActiveSheet.ListObjects(TableName).ListColumns("Emp Code").DataBodyRange.Cells(1, 1).Resize(NoOfDataRows)
    rngToCopy.Offset(NoOfDataRows).Value = rngToCopy.Value
              
              
End Sub
This works great! Thank you!!!

Like a Mandalorian this is the way :​
VBA Code:
Sub Demo2()
        Dim R&, C%
    With [Sheet1!A1].ListObject
            R = .Range.Rows.Count
        For C = 1 To 5 Step 2
           .Range(R, C)(2).Resize(R - 1).Value = .DataBodyRange.Columns(C).Value
        Next
    End With
End Sub

And this works great as well. Thank you!!!

Would you mind explaining to me how this formula picks which cells to copy? And, an additional question— what would the code look like if, say, I'd like to copy the values from E2:E to F instead?

@Alex Blakenburg & @Marc L, I appreciate you two taking the time to help me out.
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,316
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top