Dear Sir,
I am using following vb code to copy certain data in my "data" sheet.
The issue is that it is copying the correct data from "unblank" fields picked from sheet "software" range "B22:N22"
But Sheet "Software" range "D16" & "N15" are being copied also in the blank cells where information missing "B22:N22"
I want cell: D16 & N15 only on those cells where onward information is copied from "SOFTWARE B22:N22" TO "Data C:O"
Sub Save_Data()
'
ActiveSheet.Unprotect "05062080"
Range("A37").Select
ActiveSheet.PivotTables("Summary").PivotCache.Refresh
ActiveSheet.Protect "05062080"
Dim rng As Range
Dim i As Long
Dim a As Long
Dim rng_dest As Range
Application.ScreenUpdating = False
i = 1
Set rng_dest = Sheets("data").Range("C:O")
' Find first empty row in columns C:O on sheet data
Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
i = i + 1
Loop
'Copy range B22:N32 on sheet Software to Variant array
Set rng = Sheets("Software").Range("B22:N32")
' Copy rows containing values to sheet data
For a = 1 To rng.Rows.Count
If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
rng_dest.Rows(i).Value = rng.Rows(a).Value
'Copy Style Name
Sheets("data").Range("A" & i).Value = Sheets("Software").Range("D16").Value
'Copy Date
Sheets("data").Range("B" & i).Value = Sheets("Software").Range("N15").Value
i = i + 1
End If
Next a
Application.ScreenUpdating = True
End Sub
I am using following vb code to copy certain data in my "data" sheet.
The issue is that it is copying the correct data from "unblank" fields picked from sheet "software" range "B22:N22"
But Sheet "Software" range "D16" & "N15" are being copied also in the blank cells where information missing "B22:N22"
I want cell: D16 & N15 only on those cells where onward information is copied from "SOFTWARE B22:N22" TO "Data C:O"
Sub Save_Data()
'
ActiveSheet.Unprotect "05062080"
Range("A37").Select
ActiveSheet.PivotTables("Summary").PivotCache.Refresh
ActiveSheet.Protect "05062080"
Dim rng As Range
Dim i As Long
Dim a As Long
Dim rng_dest As Range
Application.ScreenUpdating = False
i = 1
Set rng_dest = Sheets("data").Range("C:O")
' Find first empty row in columns C:O on sheet data
Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
i = i + 1
Loop
'Copy range B22:N32 on sheet Software to Variant array
Set rng = Sheets("Software").Range("B22:N32")
' Copy rows containing values to sheet data
For a = 1 To rng.Rows.Count
If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
rng_dest.Rows(i).Value = rng.Rows(a).Value
'Copy Style Name
Sheets("data").Range("A" & i).Value = Sheets("Software").Range("D16").Value
'Copy Date
Sheets("data").Range("B" & i).Value = Sheets("Software").Range("N15").Value
i = i + 1
End If
Next a
Application.ScreenUpdating = True
End Sub