开发者

VBA Excel Script to copy rows with data from one worksheet & paste into another with out overwritting

Excel 2007

I'm trying to run a VBA script that will copy a list of sales Ledgers from one worksheet titled MSL with the columns DATE, INVOICE NO, COMPANY NAME, TOTAL, 开发者_运维技巧SUB-TOTAL, NETT, VAT.

1st problem i'm having is i only want to copy rows 2 and onward which contain a record and this number will change each month depending on sales.

e.g. Jan has 30 rows Feb has 24 rows Mar has 40 rows

Next i need to paste the data in to a new worksheet titled "SalesDB" with the same columns DATE, INVOICE NO, COMPANY NAME, TOTAL, SUB-TOTAL, NETT, VAT.

Next problem im having is the data is overwriting.

Thanks for any help will be out for the next hour collecting kids from school


Assuming Worksheet MLS is like the following and Worksheet SalesDB is same format:

    A      B           C               D       E           F       G 
1   Date   Invoice No  Company Name    Total   Sub-Total   Nett    VAT  
2   

This code will grab data from MLS taking account of number of entries and add to SalesDB and avoid overwriting.

 Sub CopyPasteSales
     Dim salesData as range, targetRng as range

     Set salesData = Worksheets("MLS").Range("A2:G" & Range("A1").end(xlDown).Row)

     If Worksheets("SalesDB").Range("A2") = vbNullString Then
          Set targetRng = Worksheets("SalesDB").Range("A2") //If no data in SalesDB start in row 2
     Else
          Set targetRng = Worksheets("SalesDB").Range("A1").end(xlDown).Offset(1,0) //If data already in SalesDB, find next free row
     End if

     salesData.Copy Destination:= targetRng
 End Sub


Short and dynamic: (not tested, may contain typos)

Sub CopyData()
    Dim src As Range, dest As Range
    'set source, exclude first row
    Set src = Worksheets("MLS").Range("A2").CurrentRegion.Offset(1, 0)
    'destination is one row below last row
    Set dest = Worksheets("SalesDB").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    src.Copy Destination:=dest
End Sub
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜