Copy and sort data from one sheet to another, based on cell values

问题

I have searched a lot of similar topics and have had some help but I cant find a way to do what I need (probably because of my limited experience with excel and vba), so here it goes:

I have a (Source)sheet 'offers' , which is populated daily, with the columns below:

columns:     b           c           d           e          f            g
 header:  offercode   issue dt    worktype    customer   sent dt    confirmation dt
          xxx.xx.       1/1/14      MI          john      1/1/14       3/1/14
          aaa.aa.       1/1/14      MD           bob      2/1/14
          bbb.bb        2/1/14      SI          peter     2/1/14       3/1/14

what I need is to copy all rows that get a confirmation date (not blank) in another sheet"production orders"(destination) where I generate production order codes and input other kind of data :

columns:     b           c            d           e          f            g
 header: offercode  productioncode  worktype    start       end     confirmation dt
          xxx.xx.       1/1/14       MI         5/1/14                  3/1/14
          bbb.bb        2/1/14       SI         6/1/14                  3/1/14

note that column b and b & c contain formulas (generates offer codes)

my problem is that data is populated daily, and offers(Source Sheet) should be sorted by issue date and once they get confirmed(input confirmation date->non blank) they should be copied in the other sheet but sorted (or polulate the next empty row) by confirmation date eg:

 columns:     b           c              d            e          f            g
 header: offercode  productioncode    worktype      start       end     confirmation dt
          xxx.xx.       XX.XXX.         MI         5/1/14                  3/1/14
          bbb.bb        BB.BBB          SI         6/1/14                  3/1/14
          aaa.aa.       AA>AAA          MD                                 4/1/14

another issue is how often or when is the second (Destination Sheet) list refreshs with new data, my guess is that a control button click after every data entry instance would work (and make sure that the list is up to date)

thank you in advance,

Angelos

回答1:

So, this is what is working for me right now, its all based on @simoco's code: I am checking in it for operational consistency, but the code works fine.

It copies and pastes only the columns of (my) interest where I need it and then sorts a dynamic range.

Sub copycolumnsonly()
   Dim sh1 As Worksheet
   Dim sh2 As Worksheet
   Dim lastrow1 As Long
   Dim lastrow2 As Long
   Dim j As Long
   Dim i As Long
   Dim rng As Range

   'set correct name of the sheet with your data'
   Set sh1 = ThisWorkbook.Worksheets("ÐÑÏÓÖÏÑÅÓ")

   'set correct name of the sheet where you need to paste data'
   Set sh2 = ThisWorkbook.Worksheets("ÅÍÔÏËÅÓ ÐÁÑÁÃÙÃÇÓ")

   'determining last row of your data in file ÁÁÁÁÁÁÁÁ.xlsx'
   lastrow1 = sh1.Range("C" & sh1.Rows.Count).End(xlUp).Row

   'determining last row of your data in file ÂÂÂÂÂÂÂÂ.xls'
   lastrow2 = sh2.Range("F" & sh2.Rows.Count).End(xlUp).Row

   'clear content in sheet2
    sh2.Range("F11:F" & lastrow2).ClearContents
    sh2.Range("G11:G" & lastrow2).ClearContents
    sh2.Range("N11:N" & lastrow2).ClearContents

   'suppose that in sheet2 data starts from row #11
    j = 11

    For i = 0 To lastrow1

       Set rng = sh1.Range("G11").Offset(i, 0)
       'check whether value in column D is not empy
       If Not (IsNull(rng) Or IsEmpty(rng)) Then
            sh1.Range("B" & i + 11).Copy
            sh2.Range("F" & j).PasteSpecial xlPasteValues

            sh1.Range("g" & i + 11).Copy
            sh2.Range("G" & j).PasteSpecial xlPasteValues

            sh1.Range("K" & i + 11).Copy
            sh2.Range("N" & j).PasteSpecial xlPasteValues


           j = j + 1
        End If
     Next i
     Application.CutCopyMode = False

        'sorting the new list, recorded macro tweaked to use a dynamic named range



    ActiveWorkbook.Worksheets("ÅÍÔÏËÅÓ ÐÁÑÁÃÙÃÇÓ").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ÅÍÔÏËÅÓ ÐÁÑÁÃÙÃÇÓ").Sort.SortFields.Add Key:=Range( _
        "G:G"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ÅÍÔÏËÅÓ ÐÁÑÁÃÙÃÇÓ").Sort
        .SetRange Range("PRODUCTIONORDERS")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


End Sub

回答2:

this is what I have come up with as a completly different approach,

I would greatly appreciate it if you could check it for error handling, or invalid input from users etc (see comments in code) `

Sub ActiveToLastRow()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim activerow As Long
Dim lastrow2 As Long
Dim rng As Range
Dim confirmation As Range



'set correct name of the sheet with your data
Set sh1 = ThisWorkbook.Worksheets("ÐÑÏÓÖÏÑÅÓ")

'set correct name of the sheet where you need to paste data
Set sh2 = ThisWorkbook.Worksheets("ÅÍÔÏËÅÓ ÐÁÑÁÃÙÃÇÓ")


'making sure the user selects the correct offercode via inputbox to get its rownumber --> see activerow variable

Set rng = Application.InputBox("dialeje prosfora", "epilogh prosforas", Type:=8)

'getting the information(confirmation date) via input box form the user

Dim TheString As String
Dim TheDate As Date
TheString = Application.InputBox("Enter A Date", "epibebaiwsh anathesis")
If IsDate(TheString) Then
TheDate = DateValue(TheString)
Else
MsgBox "Invalid date"
'need to end sub if user input is invalid

End If



'determining active row of your data in file ÁÁÁÁÁÁÁÁ.xlsx where data input occurs <-- user input via 1st input box
   activerow = rng.Row

   Set confirmation = sh1.Range("G" & activerow)

   confirmation.Value = TheDate

'determining last row of your data in file ÂÂÂÂÂÂÂÂ.xls'
   lastrow2 = sh2.Range("F" & sh2.Rows.Count).End(xlUp).Row

'determining what to copy and where

        sh1.Range("B" & activerow).Copy
        sh2.Range("F" & lastrow2 + 1).PasteSpecial xlPasteValues

        sh1.Range("g" & activerow).Copy
        sh2.Range("G" & lastrow2 + 1).PasteSpecial xlPasteValues

        sh1.Range("K" & activerow).Copy
        sh2.Range("N" & lastrow2 + 1).PasteSpecial xlPasteValues



        Application.CutCopyMode = False
'activating destination sheet for testing purposes

 sh2.Activate

End Sub`

回答3:

It looks like you simply need to copy over only those rows with a value in the "Confirmation Date" column - if I read the above correctly. If the sheet with the daily updates is called "First", and the resultant sheet with only the confirmed orders is called "Second", the following should do it...

Sub Macro1() ' ' Macro1 Macro '

' lastRow = 10 ' hard coded here; use whatever technique to get real value.

'Copy over the headers to the new sheet
Sheets("First").Select
Rows("1:1").Select
Selection.Copy
Sheets("Second").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:F").ColumnWidth = 9
Columns("G:G").ColumnWidth = 12
Sheets("First").Select
' Range("G1").Select
Confirm_Count = 0
For Row = 1 To lastRow
    If Len(Range("G1").Offset(Row, 0)) > 1 Then
        Rows(Row + 1).Select
        Selection.Copy
        Sheets("Second").Select
        Confirm_Count = Confirm_Count + 1
        Range("A1").Offset(Confirm_Count, 0).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Sheets("First").Select
    End If
Next Row

End Sub

来源：https://stackoverflow.com/questions/20899120/copy-and-sort-data-from-one-sheet-to-another-based-on-cell-values