Copy entire row if cell is not empty - VBA

pantakos

Board Regular
Joined
Oct 10, 2012
Messages
158
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello,

There is a need to copy contents from a sheet if the value of a specific cell is NOT 0 or it is blank.
Need to copy the entire row and its contents to another sheet. Basically need to create rows in target sheet and not overwriten them.
Lets say that the source sheet is AUDIO and the target is TEST1. The value that needed to check is range B13:B25
Can this be done with multiple source sheets and multiple source ranges? All will copied to the same target sheet.

I have found some posts in mrexcel but I cant make them to work properly (maybe multiple criteria are wrong)

Can you help?

Thank you in advance!
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Hi,​
according to such basic need did you at least try a filter or an advanced filter ?​
 
Upvote 0
Yes a VBA procedure can reproduce what you can operate manually, try the Macro Recorder for starters …​
 
Upvote 0
Yes a VBA procedure can reproduce what you can operate manually, try the Macro Recorder for starters …​
Ok I need VBA

Can you help? I have found this one from another post
VBA Code:
Sub macro1()

Dim c As Range
Dim Source As Worksheet
Dim Target As Worksheet
Dim Target1 As Worksheet

Set Source = ActiveWorkbook.Worksheets("AUDIO")
Set Target = ActiveWorkbook.Worksheets("PROFORMA DRYHIRE")
Set Target1 = ActiveWorkbook.Worksheets("PROFORMA DRYHIRE")

For Each c In Source.Range("E13:E25" & Source.Cells(Rows.Count, 1).End(xlUp).Row)
   If c = "Q1" Then
      c.EntireRow.Copy
      Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   ElseIf c = "Q2" Then
      c.EntireRow.Copy
      Target1.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   End If
Next c
End Sub

But now copying row by row but put all together at target sheet.

Can you help me to make this happen?

Thank you
 
Upvote 0
The last code you posted seems to have different conditions that you expressed in your original post.
Can you post a sample of your data, and explain to us which of the rows in your example should be copied over?

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.
 
Upvote 0
The last code you posted seems to have different conditions that you expressed in your original post.
Can you post a sample of your data, and explain to us which of the rows in your example should be copied over?

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.
Yes , Here is the example of the data

AUDIO TAB (SHEET)

SPEAKERSSTOCKPRICE PER DAYPCS
CLAIR BROS C1216€110,0012
CLAIR BROS C816€50,00
CLAIR BROS CS1184€50,00
L-ACOUSTICS V-DOSC40€80,0015


LIGHTS TAB (SHEET)

MOVING LITESSTOCKPRICE P/DPCS
ROBE BMFL WASH BEAM20€150,00
CLAY PAKY MYTHOS -262€100,003
CLAY PAKY SHARPY16€50,004
CLAY PAKY HPE 1500 SPOT32€80,00


INVOICE

MANAGER
PRO-FORMACLIENT
DESCRIPTIONPCSPRICE PER DAYTOTAL
CLAIR BROS C1212€110,001.320,00 €
L-ACOUSTICS V-DOSC15€80,001.200,00 €
CLAY PAKY MYTHOS -23€100,00300,00 €
CLAY PAKY SHARPY4€50,00200,00 €
0,00 €
TOTAL3.020,00 €
VAT724,80 €
FINAL TOTAL3.744,80 €

So when user change PCS to an item (AUDIO, LIGHTS or more tabs) then this will be filled to invoice (DESCRIPTION, PCS, PRICE PER DAY), pressing a button or automatically
 
Upvote 0
What cell does the Invoice Data start on?
What is on the Invoice sheet before adding any data?
Are the Totals rows already there, or do they need to be added?
 
Upvote 0
What cell does the Invoice Data start on?
What is on the Invoice sheet before adding any data?
Are the Totals rows already there, or do they need to be added?
The invoice Data starts on A15 , A1-A14 is compay logo etc, of course it can be started on whatever cell
From A15 nothing are empty cells
Total already there

INVOICE
ΥΠΕΥΘΥΝΟΣ
ΠΡΟΣΦΟΡΑ / PRO-FORMA ΠΕΛΑΤΗΣ
NO: ΥΠΟΨΙΝ
ΔΙΕΥΘΥΝΣΗ
ΠΟΛΗ
ΑΦΜ
ΔOY
ΤΗΛ
email
ΠΑΡΑΓΩΓΗ
ΠΕΡΙΟΔΟΣ
DESCRIPTIONPCSPRICETOTAL
0,00 €
0,00 €
0,00 €
0,00 €
0,00 €
0,00 €
0,00 €
0,00 €


and this is a sample of source sheet

SPEAKERS QTYPRICE PER DAYPCS
CLAIR BROS C1216€110,0010
CLAIR BROS C8 16€50,00
CLAIR BROS CS1184€50,00
L-ACOUSTICS V-DOSC40€80,00
L-ACOUSTICS dV-DOSC114€30,00
L-ACOUSTICS KUDO6€60,00
L-ACOUSTICS SYVASET L-R€310,00
L-ACOUSTICS ARCS WIDE16€40,00
L-ACOUSTICS X1524€45,00
L-ACOUSTICS X1224€35,00
L-ACOUSTICS X816€30,00


Thank you for your help
 
Upvote 0
This should work. It may need some minor modifications, based on the structure of your data sheets (I assumed your data is in columns B-E in rows 13:25, as your original code was looking in E13:E25).
VBA Code:
Sub BuildInvoice()

    Dim ws
    Dim i As Long
    Dim cell As Range
    Dim Descript As String
    Dim PPD As Double
    Dim PCS As Long
    Dim nr As Long
    
    Application.ScreenUpdating = False
    
'   Set array of worksheet names to copy from
    ws = Array("AUDIO", "LIGHTS")
    
    For i = LBound(ws) To UBound(ws)
'       Iterate through column D on each sheet looking for pieces
        For Each cell In Sheets(ws(i)).Range("E13:E25")
'           See if anything entered in pieces
            If cell > 0 Then
                Descript = cell.Offset(0, -3)  'get description from column B
                PPD = cell.Offset(0, -1) 'get price p/d from column D
                PCS = cell  'get pieces from column E
'               Find next available row in column A on Invoice sheet
                nr = Sheets("Invoice").Cells(Rows.Count, "A").End(xlUp).Row + 1
'               Populate values on Invoice sheet
                Sheets("Invoice").Cells(nr, "A") = Descript
                Sheets("Invoice").Cells(nr, "B") = PCS
                Sheets("Invoice").Cells(nr, "C") = PPD
            End If
        Next cell
    Next i
    
    Application.ScreenUpdating = False
    
    MsgBox "Invoice built!"
        
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,255
Members
448,556
Latest member
peterhess2002

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