• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VB CODE TO SAVE DATA FROM ONE SHEET TO ANOTHER

Ateeb Ali

Member
Hi, I am using following vb code
Code:
Sub Save_Data()

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("Database").Range("D:F")
  ' Find first empty row in columns D:F on sheet Database
  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range AE30:AG46 on sheet Quote to Variant array
  Set rng = Sheets("Quote").Range("AE30:AG46")
    ' Copy rows containing values to sheet Database
  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 Date
      Sheets("Database").Range("A" & i).Value = Sheets("Quote").Range("J15").Value
      'Copy Quote#
      Sheets("Database").Range("B" & i).Value = Sheets("Quote").Range("J16").Value
      'Copy Customer
      Sheets("Database").Range("C" & i).Value = Sheets("Quote").Range("J17").Value
      
      
    i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True

Range("J16").Value = Range("J16").Value + 1
Range("J17").ClearContents
Range("D16:E18").ClearContents
Range("D3:E3").ClearContents
Range("D4:J5").ClearContents
Range("P30:P46").ClearContents
Range("C30:E46").ClearContents

End Sub

Its working fine but also copying data all the way down because my cells containes formula
cell range AE30:AG46 (Sheet: Quote)
So it is copying all empty data all the way, I just want to copy that data which is visible, i am using following formula in cell
For example cell: AE30 have formula : =+IF(C30="","",$B$25&$AF$29&C30&$AE$29&D30&$AE$29&E30&$AG$29&$D$28)
 
Hi,​
to copy only the visible cells just use the Range.Copy method or better via an advanced filter …​
 
Dear Sir, can you help amending the code, i did as below but not working;
Code:
Sub Save_Data()

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("Database").Range("D:F")
  ' Find first empty row in columns D:F on sheet Database
  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range AE30:AG46 on sheet Quote to Variant array
  Set rng = Sheets("Quote").Range.Copy("AH30:AJ46")
    ' Copy rows containing values to sheet Database
  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 Date
      Sheets("Database").Range("A" & i).Value = Sheets("Quote").Range("I15").Value
      'Copy Quote#
      Sheets("Database").Range("B" & i).Value = Sheets("Quote").Range("I16").Value
      'Copy Customer
      Sheets("Database").Range("C" & i).Value = Sheets("Quote").Range("I17").Value
     
     
    i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True


End Sub
 
Last edited by a moderator:
If anyone guess in the next 12h so better is to explain what is 'not working' and clearly what is the need …​
 
Dear Sir
I have enclosed actual file as well, i wanted to copy only visible value in range to another sheet
the range has formula and I just want the "code amendment" which wont copy the black range

Not working means I mentioned code .range.copy but its not working and giving error in vb
Run-time error '424':
Object required
 
Back
Top