Hi Lunatu,
Use below code:
VBA Code:
Option Explicit
Sub copyData()
Dim wb As New Workbook, rowToCopy As Integer
Dim lRow As Integer, nRow As Integer, rowno As Integer, colno As Integer
'Create workbook with name ProductData in which data will be copied. Keep the file open.
Set wb = Workbooks("ProductData.xlsx")
lRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
nRow = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
rowToCopy = nRow
For rowno = 2 To lRow
If ThisWorkbook.Sheets("Sheet1").Range("H" & rowno) = "won" Then
For colno = 2 To 7
If ThisWorkbook.Sheets("Sheet1").Cells(rowno, colno) <> "" Then
ThisWorkbook.Sheets("Sheet1").Range("A" & rowno).Copy wb.Sheets("Sheet1").Range("A" & rowToCopy) 'To copy customer name
ThisWorkbook.Sheets("Sheet1").Cells(1, colno).Copy wb.Sheets("Sheet1").Range("B" & rowToCopy) 'To copy product name
ThisWorkbook.Sheets("Sheet1").Cells(rowno, colno).Copy wb.Sheets("Sheet1").Range("C" & rowToCopy) 'To copy product value
rowToCopy = rowToCopy + 1
End If
Next
End If
Next
End Sub
Hi,
still few question if you could help me. I modified the code a little bit:
- column H can be either "won" or "part-wont", the code should copy if either of them are in the cell
- in column I i have added date and I want to copy all rows from yesterday --> current date - 1
- there must be text in column A
- I added formulas in columns B-G and I want to paste the values not the formulas.
The code I modified is not working:
Sub copyData()
Dim wb As New Workbook, rowToCopy As Integer
Dim lRow As Integer, nRow As Integer, rowno As Integer, colno As Integer
Set wb = Workbooks("ProductData.xlsx")
lRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
nRow = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
rowToCopy = nRow
For rowno = 2 To lRow
If ThisWorkbook.Sheets("Sheet1").Range("H" & rowno) = "won" Or ThisWorkbook.Sheets("Sheet1").Range("Q" & rowno) = "part-won" And ThisWorkbook.Sheets("Sheet1").Range("I" & rowno) = Date - 1 And ThisWorkbook.Sheets("Sheet1").Range("A" & rowno) > 0 Then
For colno = 2 To 7
If ThisWorkbook.Sheets("Sheet1").Cells(rowno, colno) <> "" Then
ThisWorkbook.Sheets("Sheet1").Range("A" & rowno).Copy wb.Sheets("Sheet1").Range("A" & rowToCopy)
ThisWorkbook.Sheets("Sheet1").Cells(1, colno).Copy wb.Sheets("Sheet1").Range("B" & rowToCopy)
ThisWorkbook.Sheets("Sheet1").Cells(rowno, colno).Copy wb.Sheets("Sheet1").Range("C" & rowToCopy)
rowToCopy = rowToCopy + 1
End If
Next
End If
Next
End Sub