VBA Modification help - copy data from columns to another column

lawi227

Board Regular
Joined
Mar 17, 2016
Messages
123
This is my current attempt at copying data from one tab and pasting into a table on a different tab. I began modifying the code below. The text highlighted in yellow is where I need help.

Essentially, here are the two scenarios:
ONE-
If F5 on the "Instructions" tabs = 1, then copy columns H:J starting at row 4 on sheet "Selected LP List" to the last three empty columns on the sheet "LPA Database Raw Data". NOTE: The range for the columns where the text should be copied into are F:EY and start at row 5

TWO-
If F5 on the "Instructions" tabs = 2, then copy columns H:J and L:N starting at row 4 on sheet "Selected LP List" to the last six empty columns on the sheet "LPA Database Raw Data". NOTE: The range for the columns where the text should be copied into are F:EY and start at row 5


This formula below worked well for me when I was copying data. It identified the last row, but I have re-organized my worksheets and now I am looking at the columns.



<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; background-color: #ffffff; min-height: 13.0px}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #008f00; background-color: #ffffff}p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #011993; background-color: #ffffff}span.s1 {color: #011993}span.s2 {color: #000000}</style>
Public Sub PasteToLastRow()


Dim instructionsSheet As Worksheet
Dim databaseSheet As Worksheet
Dim lastRow As Long


Set instructionsSheet = Sheets("Instructions")
Set databaseSheet = Sheets("LPA Database Scores")


lastRow = databaseSheet.Range("C118").End(xlUp).Row + 1
If lastRow = 118 Then
' No more spare rows
Exit Sub
End If


' Copy the data
databaseSheet.Range("B56:AQ57" & CStr(5 + instructionsSheet.Range("F5").Value)).Copy
databaseSheet.Cells(lastRow, 2).PasteSpecial Paste:=xlPasteValues


End Sub
<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; background-color: #ffffff; min-height: 13.0px}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #008f00; background-color: #ffffff}p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #011993; background-color: #ffffff}span.s1 {color: #011993}span.s2 {color: #000000}</style><style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}span.s1 {color: #011993}</style>
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
The text highlighted in yellow is where I need help.

Essentially, here are the two scenarios:
ONE-
If F5 on the "Instructions" tabs = 1, then copy columns H:J starting at row 4 on sheet "Selected LP List" to the last three empty columns on the sheet "LPA Database Raw Data". NOTE: The range for the columns where the text should be copied into are F:EY and start at row 5

TWO-
If F5 on the "Instructions" tabs = 2, then copy columns H:J and L:N starting at row 4 on sheet "Selected LP List" to the last six empty columns on the sheet "LPA Database Raw Data". NOTE: The range for the columns where the text should be copied into are F:EY and start at row 5

I think you missed the highlighter :) Nothing in yellow.

Also your instruction on what you want is not clear.

Scenario one you say if Sheet "Instructions" Cell F5 = 1 then you want to copy columns H:J starting at row 4 (End Range? H4:J?) FROM the Sheet "Selected LP List" and paste them to the last three empty columns on Sheet "LPA Database Raw Data"
You then give a range for the data to be copied to F:EY starting on row 5? You previously mentioned copying this to the last 3 columns which contradicts with F:EY?

Similar question for scenario two.

If you can provide a little clarity I think I can help. <style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; background-color: #ffffff; min-height: 13.0px}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #008f00; background-color: #ffffff}p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #011993; background-color: #ffffff}span.s1 {color: #011993}span.s2 {color: #000000}</style><style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; background-color: #ffffff; min-height: 13.0px}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #008f00; background-color: #ffffff}p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #011993; background-color: #ffffff}span.s1 {color: #011993}span.s2 {color: #000000}</style><style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}span.s1 {color: #011993}</style>
 
Upvote 0
Sorry - I guess I posted too quickly.

The range is from H4:J740.

What I meant when I said F:EY is that those are the columns where the data is currently housed. Currently I have data in cells F:BM. So that means that the next available column that is blank starts at BN. Once I run the macro, I would expect that H4:J740 to be pasted in BN5:BP741. Then the next time I use the workbook, the next empty column would start at BQ. I would then repeat the process.

Keep in mind, the scenario I laid out above is for when F5 = 1. If F5=2 then there would be a total of 6 columns pasted from the "Selected LP List" to the "LPA Database Raw Data".

Thanks so much for your help!

I think you missed the highlighter :) Nothing in yellow.

Also your instruction on what you want is not clear.

Scenario one you say if Sheet "Instructions" Cell F5 = 1 then you want to copy columns H:J starting at row 4 (End Range? H4:J?) FROM the Sheet "Selected LP List" and paste them to the last three empty columns on Sheet "LPA Database Raw Data"
You then give a range for the data to be copied to F:EY starting on row 5? You previously mentioned copying this to the last 3 columns which contradicts with F:EY?

Similar question for scenario two.

If you can provide a little clarity I think I can help. <style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; background-color: #ffffff; min-height: 13.0px}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #008f00; background-color: #ffffff}p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #011993; background-color: #ffffff}span.s1 {color: #011993}span.s2 {color: #000000}</style><style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; background-color: #ffffff; min-height: 13.0px}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #008f00; background-color: #ffffff}p.p4 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #011993; background-color: #ffffff}span.s1 {color: #011993}span.s2 {color: #000000}</style><style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}span.s1 {color: #011993}</style>
 
Upvote 0
If J740 does not change this will do the trick.

Code:
Sub Test()

Dim LastCol As Integer


If Sheets("Instructions").Range("F5") = 1 Then


    Sheets("Selected LP List").Range("H4:J740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    End With
        
    If LastCol >= 154 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol + 1).PasteSpecial (xlPasteValues)


ElseIf Sheets("Instructions").Range("F5") = 2 Then


    Sheets("Selected LP List").Range("H4:J740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    End With
        
    If LastCol >= 151 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol + 1).PasteSpecial (xlPasteValues)


    Sheets("Selected LP List").Range("L4:N740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    End With
        
    If LastCol >= 151 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol + 1).PasteSpecial (xlPasteValues)


End If


End Sub
 
Upvote 0
I'm not sure what you meant by if J740 does not change. Why that cell in particular? It won't change though.


I ran the macro and should have made one thing more clear that will impact how the macro searches for an "empty column." I'm guessing right not it is just searching for the first column where row 5 is blank? Because when I ran the macro, it identified cell AA:AC as blank, although there was data in row 76, but not rows 5 through 75. Does that make sense? I need the macro to search the whole column (row 5 through 741) for all blanks. Sorry for the confusion.

If J740 does not change this will do the trick.

Code:
Sub Test()

Dim LastCol As Integer


If Sheets("Instructions").Range("F5") = 1 Then


    Sheets("Selected LP List").Range("H4:J740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    End With
        
    If LastCol >= 154 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol + 1).PasteSpecial (xlPasteValues)


ElseIf Sheets("Instructions").Range("F5") = 2 Then


    Sheets("Selected LP List").Range("H4:J740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    End With
        
    If LastCol >= 151 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol + 1).PasteSpecial (xlPasteValues)


    Sheets("Selected LP List").Range("L4:N740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    End With
        
    If LastCol >= 151 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol + 1).PasteSpecial (xlPasteValues)


End If


End Sub
 
Upvote 0
Any luck with this? Much appreciated!

If J740 does not change this will do the trick.

Code:
Sub Test()

Dim LastCol As Integer


If Sheets("Instructions").Range("F5") = 1 Then


    Sheets("Selected LP List").Range("H4:J740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    End With
        
    If LastCol >= 154 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol + 1).PasteSpecial (xlPasteValues)


ElseIf Sheets("Instructions").Range("F5") = 2 Then


    Sheets("Selected LP List").Range("H4:J740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    End With
        
    If LastCol >= 151 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol + 1).PasteSpecial (xlPasteValues)


    Sheets("Selected LP List").Range("L4:N740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    End With
        
    If LastCol >= 151 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol + 1).PasteSpecial (xlPasteValues)


End If


End Sub
 
Upvote 0
Sorry been busy try this, it will find the first blank column in row 5 then go from there checking each row until it finds a column with all blank values.

Let me know if this works for you.

Code:
Sub Test()

Dim LastCol As Integer


If Sheets("Instructions").Range("F5") = 1 Then


    Sheets("Selected LP List").Range("H4:J740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
        
        RLastCol = False
        
        Do Until RLastCol = True
        
        For i = 5 To 740
        
        If Cells(i, LastCol).Value = "" Then
        Else
        LastCol = LastCol + 1
        Exit For
        
        End If
    
        Next i
        
        If i = 741 And Cells(i, LastCol).Value = "" Then
        RLastCol = True
        End If
        
        Loop
        
    End With
        
    If LastCol >= 154 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol).PasteSpecial (xlPasteValues)


ElseIf Sheets("Instructions").Range("F5") = 2 Then


    Sheets("Selected LP List").Range("H4:J740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
        
        RLastCol = False
        
        Do Until RLastCol = True
        
        For i = 5 To 740
        
        If Cells(i, LastCol).Value = "" Then
        Else
        LastCol = LastCol + 1
        Exit For
        
        End If
    
        Next i
        
        If i = 741 And Cells(i, LastCol).Value = "" Then
        RLastCol = True
        End If
        
        Loop
        
    End With
        
    If LastCol >= 151 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol).PasteSpecial (xlPasteValues)


    Sheets("Selected LP List").Range("L4:N740").Copy
    
    Sheets("LPA Database Raw Data").Activate
    
    With ActiveSheet
        LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
        
        RLastCol = False
        
        Do Until RLastCol = True
        
        For i = 5 To 740
        
        If Cells(i, LastCol).Value = "" Then
        Else
        LastCol = LastCol + 1
        Exit For
        
        End If
    
        Next i
        
        If i = 741 And Cells(i, LastCol).Value = "" Then
        RLastCol = True
        End If
        
        Loop
        
    End With
        
    If LastCol >= 151 Then
    MsgBox ("You are out of available space")
    Exit Sub
    ElseIf LastCol < 6 Then
    LastCol = 5
    End If
        
    Sheets("LPA Database Raw Data").Cells(5, LastCol).PasteSpecial (xlPasteValues)


End If


End Sub
 
Upvote 0
I'm not sure what you meant by if J740 does not change. Why that cell in particular? It won't change though.

The reason I ask is because I hard coded this number in

(Copy from H4:J740 as well as the loop For I = 5 to 740)

so if you ever end up adding more rows to the sheet you would need to adjust this code to accommodate. It can be coded to adjust for the change I just neglected to do this.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,912
Messages
6,175,340
Members
452,637
Latest member
Ezio2866

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