VBA - Copy/Paste last value in column if the next cell is empty

Mortenhoey

New Member
Joined
Apr 12, 2021
Messages
32
Office Version
  1. 365
Platform
  1. Windows
HI

I need to copy the last value in the column every month and copy paste it into another document which shows the KPI for the current month. So if you look up the picture i need all the values from mar2021 to be copied this month and apr2021 next month.

Is it possible to make some kind of VBA code for copy and paste last column in row if the value beside it is empty (like in apr2021).

Picture
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
I presumed the workbook that you want to copy to is where the macro is located. When run,, a dialog will ask you to select the workbook with data you want to copy from. Note that you need to modify sheet name accordingly is required.
VBA Code:
Sub Test()

Dim erngCol As Range, nxEmptyCol As Range
Dim Fname As Variant
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wbA As Workbook, wbB As Workbook
Dim rngTotal As Range

Application.ScreenUpdating = False

' Define this Workbook as wbA
Set wbA = ActiveWorkbook
' Define working sheet in wbA. Change sheet name accordingly
Set ws1 = wbA.Sheets("Sheet1")

' Search destination Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub                         'CANCEL is clicked

' Define opened Workbook as wbB while opening it.
Set wbB = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
' Define working sheet in wbB. Change sheet name accordingly
Set ws2 = wbB.Sheets("Sheet1")

' Search for last column range in wbB
Set erngCol = ws2.Range("A2").End(xlToRight)

' Find next empty column in ws1
Set nxEmptyCol = ws1.Cells(2, ws1.Columns.Count).End(xlToLeft).Offset(0, 1)

' Copy end column range to ws1.Range("B2")
ws2.Range(erngCol, erngCol.End(xlDown)).Copy nxEmptyCol

wbB.Close False

End Sub
 
Upvote 0
Solution
Where does it paste the values into the column called this months KPI? :)
To This month data column like shown in your arrow. It will automatically fill the next empty column for subsequent month.
 
Upvote 0
So if i wanna run the macro from the workbook called mappe2, and importing data from workbook = Ny, what is wbA and wbB?
 
Upvote 0
So if i wanna run the macro from the workbook called mappe2, and importing data from workbook = Ny, what is wbA and wbB?
wbA or whatever is just a variable I declare to refer to workbooks. Same like ws1, ws2 whatever. This way you do not need to type long name every time.
When I do:
Set wbA = wWorkbook("mappe2")
Set ws1 = wbA.Sheets("Sheet1")

next time in code I just need to type ws1 instead of Workbook("mappe2").Sheets("Sheet1")

since the Workbook("mappe") is the active workbook (I presumed where the code will reside), I can just declare like below without mentioning the name
Set wbA = ActiveWorkbook
 
Upvote 0
Zot

Is it possible to copy paste different rows. Like i only want the values from E2, E4, E9, E10, E12 Is it possible? :) I need to copy paste these five, every month and maybe more over time. :)
 
Upvote 0
Zot

Is it possible to copy paste different rows. Like i only want the values from E2, E4, E9, E10, E12 Is it possible? :) I need to copy paste these five, every month and maybe more over time. :)
It is possible but need some modification. Need to copy selected cell. However, before I do that I want to know how you want to lay out your data collection sheet. Same like current one with blanks on E1, E3, E5, E6 ... etc?
 
Upvote 0
While waiting for your answer since we are on different time zone ...?

In this code, before running program you need to write down in strRow which Ex to be copied. In this sample strRow = "E2 E4 E9 E10 E12" (see code). The program will find the actual Excel row from Ex row and fetch data form selected row to copy to ws1. The program search the actual row using ws2 and use same destination row in ws1 since the Ex rows in ws1 and ws2 are the same.
VBA Code:
Sub CopySelectedRange()

Dim nCol As Long
Dim erngCol As Range, rngFound As Range
Dim Fname As Variant, nRow As Variant
Dim strRow As String, ArryRow() As String
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wbA As Workbook, wbB As Workbook
Dim rngTotal As Range

Application.ScreenUpdating = False

' Define this Workbook as wbA
Set wbA = ActiveWorkbook
' Define working sheet in wbA. Change sheet name accordingly
Set ws1 = wbA.Sheets("Sheet1")

' Search destination Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub                         'CANCEL is clicked

' Define opened Workbook as wbB while opening it.
Set wbB = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
' Define working sheet in wbB. Change sheet name accordingly
Set ws2 = wbB.Sheets("Sheet1")

' Define Ex to be copied separated by space
strRow = "E2 E4 E9 E10 E12"

' Store strRow as array
ArryRow = Split(strRow)

' Get actual row number from Ex designations into strRow
strRow = ""
For Each nRow In ArryRow
    Set rngFound = ws2.Range("A2:A16").Find(nRow)
    If Not rngFound Is Nothing Then
        If strRow = "" Then
            strRow = rngFound.Row
        Else
            strRow = strRow & " " & rngFound.Row
        End If
    End If
Next

' Store new strRow as array
Erase ArryRow
ArryRow = Split(strRow)

' Search for last column range in wbB
Set erngCol = ws2.Range("A2").End(xlToRight)

' Find next empty column number in ws1
nCol = ws1.Cells(2, ws1.Columns.Count).End(xlToLeft).Offset(0, 1).Column

' Write selected row data from ws2
For Each nRow In ArryRow
    ws1.Cells(nRow, nCol) = ws2.Cells(nRow, nCol)
Next

wbB.Close False

End Sub
 
Upvote 0

Forum statistics

Threads
1,223,239
Messages
6,170,947
Members
452,368
Latest member
jayp2104

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