Copy Down to last row and paste to Last row

gheyman

Well-known Member
Joined
Nov 14, 2005
Messages
2,332
Office Version
  1. 365
Platform
  1. Windows
I need to complete this code, but having problems. I want to find the last row of A then copy from B3 down to that last row. Then Paste column B at the bottom of Row A - then I want to do that again for columns C, D... all the way to column Z (Each time only copying down to what the original Last row was for column A).

Code:
Sub CreateYears()

 Dim DMlr1 As Long
 
 'Clear IHSCodwYear table
 
 ClearIHSCodewYearTable
 
 '2010
        Dim Lr1 As Long
        
        'Transfer Data from IHS Codes
        Sheets("IHS Codes").ListObjects("IHS_Codes").DataBodyRange.Copy Sheets("IHS Codes wYear").Range("A2")
        
        
        Dim PPlr10 As Long
        
        'Clear existing data if any on PP Materials Input tab
        PPlr10 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row
        If PPlr10 > 2 Then Sheets("IHS Codes wYear").Range("B2:B" & PPlr1).Copy
        
        
        
        
End Sub

Thank you for the help, it is appreciated.
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Thanks but I dont see where any of these really help with this. I know how to find the last Row. But I want to maintain that information and use it in one part of the code while using the new last row in another

Code:
Sub CreateYears()
 
 'Clear IHSCodwYear table
 ClearIHSCodewYearTable
 
 'Get IHS Codes from IHS Codes tabe
         'Transfer Data
        Sheets("IHS Codes").ListObjects("IHS_Codes").DataBodyRange.Copy Sheets("IHS Codes wYear").Range("A2")
 
 'HERES WHERE I NEED THE HELP.  NEED TO COPY EACH COLUMN DOWN TO TEH ORIGINAL RANGE AND THEN PASTE IT TO THE BOTTOM OF THE NEW LAST ROW OF COLUMN A
 '2010
        Dim Lr1 As Long
        Dim Lr10 As Long

        
        Lr1 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row
'        Rng = Lr1

        If Lr1 > 2 Then Sheets("IHS Codes wYear").Range("B2:B" & Lr1).Select
            Selection.Copy
            
        
        Lr10 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row
            Sheets("IHS Codes wYear").Range("A" & Lr10).Paste
        
        
        
        
End Sub
 
Upvote 0
When I start column A goes down to row 69. The first time I run this it works great. It paste row B from B2 down to B69 in column A starting at row 70. But when I run it a second time I would expect it to Paste B2:B69 on the bottom of column A which would now be row 137 (the new last row+1). It does not. It pastes it oever A70 down. It does not find the new last row of (A137) which is what I thought "Lr10 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row" would do. Any help is appreciated.

Code:
Sub CreateYears()
 
 'Clear IHSCodwYear table
 
 ClearIHSCodewYearTable
 
 'Get IHS Codes from IHS Codes tabe
         'Transfer Data
        Sheets("IHS Codes").ListObjects("IHS_Codes").DataBodyRange.Copy Sheets("IHS Codes wYear").Range("A2")
 
 '2010
        Dim Lr1 As Long
        Dim Lr10 As Long

        
        Lr1 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row
'        Rng = Lr1

        If Lr1 > 2 Then Sheets("IHS Codes wYear").Range("B2:B" & Lr1).Select
            Selection.Copy
            
        
        Lr10 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row
 '           Sheets("IHS Codes wYear").Range("A:" & Lr10).Select
  '              Selection.Paste
        
        Sheets("IHS Codes wYear").Range("A" & Lr10 + 1).PasteSpecial xlPasteValues
        
        
End Sub
 
Upvote 0
Basically trying to append whats in columns B through Z to the bottom of A

Code:
Sub CreateYears()
 
 'Clear IHSCodwYear table
 
 ClearIHSCodewYearTable
 
 'Get IHS Codes from IHS Codes tabe
         'Transfer Data
        Sheets("IHS Codes").ListObjects("IHS_Codes").DataBodyRange.Copy Sheets("IHS Codes wYear").Range("A2")
 
Dim Lr1 As Long
Dim Lr10 As Long
Dim Lr11 As Long

        
        Lr1 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row
'        Rng = Lr1

 '2010
        If Lr1 > 2 Then Sheets("IHS Codes wYear").Range("B2:B" & Lr1).Select
            Selection.Copy
                Lr10 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row
                    Sheets("IHS Codes wYear").Range("A" & Lr10 + 1).PasteSpecial xlPasteValues
                    
 '2011
        If Lr1 > 2 Then Sheets("IHS Codes wYear").Range("C2:C" & Lr1).Select
            Selection.Copy
                Lr11 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row
                    Sheets("IHS Codes wYear").Range("A" & Lr11 + 1).PasteSpecial xlPasteValues
                    
 '2012
        If Lr1 > 2 Then Sheets("IHS Codes wYear").Range("D2:D" & Lr1).Select
            Selection.Copy
                Lr12 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row
                    Sheets("IHS Codes wYear").Range("A" & Lr12 + 1).PasteSpecial xlPasteValues
                    
 '2013
        If Lr1 > 2 Then Sheets("IHS Codes wYear").Range("D2:D" & Lr1).Select
            Selection.Copy
                Lr12 = Sheets("IHS Codes wYear").Cells(Rows.Count, "A").End(xlUp).Row
                    Sheets("IHS Codes wYear").Range("A" & Lr12 + 1).PasteSpecial xlPasteValues
                    
                    
        
        
End Sub
 
Upvote 0
Here is a basic example that copy the data in B:? to column A, there is no test for a empty column in this example

Sub test()

Dim LastCol As Integer
Dim LastRowA As Long
Dim LastRow As Long

With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

For I = 2 To LastCol
With ActiveSheet
LastRowA = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
LastRow = .Cells(.Rows.Count, I).End(xlUp).Row
End With

Range(Cells(1, I), Cells(LastRow, I)).Copy Range("A" & LastRowA)

Next I
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,553
Messages
6,114,279
Members
448,562
Latest member
Flashbond

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