macro help

[mikesal57]

Hi.

I'm a newbie to this..

I have created a macro to extract data from worksheet to add to an existing list on another sheet..
my problem is that each time i execute the macro it puts the records over the same lines each time , instead of adding it to the list.

what can i do?

thxs
Mike

 

[Sektor]

You need first to define last row in a range you add to going from down to top like this:

[COLOR="Blue"]Sub[/COLOR] AddData()

    [COLOR="Blue"]Dim[/COLOR] lastRow [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Long[/COLOR]
    [COLOR="Blue"]Dim[/COLOR] shSource [COLOR="Blue"]As[/COLOR] Worksheet
    [COLOR="Blue"]Dim[/COLOR] shTarget [COLOR="Blue"]As[/COLOR] Worksheet
    [COLOR="Blue"]Dim[/COLOR] rngSource [COLOR="Blue"]As[/COLOR] Range
    [COLOR="Blue"]Dim[/COLOR] rngTarget [COLOR="Blue"]As[/COLOR] Range
    
    [COLOR="Blue"]Set[/COLOR] shSource = Worksheets("Source")
    [COLOR="Blue"]Set[/COLOR] shTarget = Worksheets("Target")
    [COLOR="Blue"]Set[/COLOR] rngSource = shSource.Range("A1:A100")
    
    [COLOR="Blue"]With[/COLOR] shTarget
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        rngSource.Copy .Cells(lastRow, "A")
    [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]With[/COLOR]

[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]

 

[mikesal57]

thxs for response..

how would I apply it here?

ActiveWindow.SmallScroll Down:=12
Sheets("Mike").Select
Range("D3:U17").Select
Sheets("Sheet1").Select
ActiveWindow.SmallScroll Down:=243
ActiveWindow.ScrollRow = 257
ActiveWindow.ScrollRow = 260
ActiveWindow.ScrollRow = 263
ActiveWindow.ScrollRow = 267
ActiveWindow.ScrollRow = 274
ActiveWindow.ScrollRow = 280
ActiveWindow.ScrollRow = 287
Activ


ActiveWindow.ScrollRow = 652
ActiveWindow.ScrollRow = 654
ActiveWindow.ScrollRow = 656
ActiveWindow.ScrollRow = 657
ActiveWindow.ScrollRow = 658
Range("A674").Select
Sheets("Mike").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A674").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub


thxs

 

[Sektor]

Try this.

[COLOR="Blue"]Sub[/COLOR] AddData()

    [COLOR="Blue"]Dim[/COLOR] lastRow [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Long[/COLOR]
    [COLOR="Blue"]Dim[/COLOR] shSource [COLOR="Blue"]As[/COLOR] Worksheet
    [COLOR="Blue"]Dim[/COLOR] shTarget [COLOR="Blue"]As[/COLOR] Worksheet
    [COLOR="Blue"]Dim[/COLOR] rngSource [COLOR="Blue"]As[/COLOR] Range
    [COLOR="Blue"]Dim[/COLOR] rngTarget [COLOR="Blue"]As[/COLOR] Range
    
    [COLOR="Blue"]Set[/COLOR] shSource = Worksheets("Mike")
    [COLOR="Blue"]Set[/COLOR] shTarget = Worksheets("Sheet1")
    [COLOR="Blue"]Set[/COLOR] rngSource = shSource.Range("D3:U17")
    
    [COLOR="Blue"]With[/COLOR] shTarget
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        rngSource.Copy
        .Cells(lastRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
    [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]With[/COLOR]

[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]

 

[mikesal57]

This is dumb..

but do I erase all my routines and just add yours to my sub?

 

[Sektor]

Instead of deleting, comment all your code, try my code. In case of failure, delete my code and uncomment your code.

 

[mikesal57]

Try this.

[COLOR=Blue]Sub[/COLOR] AddData()

    [COLOR=Blue]Dim[/COLOR] lastRow [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
    [COLOR=Blue]Dim[/COLOR] shSource [COLOR=Blue]As[/COLOR] Worksheet
    [COLOR=Blue]Dim[/COLOR] shTarget [COLOR=Blue]As[/COLOR] Worksheet
    [COLOR=Blue]Dim[/COLOR] rngSource [COLOR=Blue]As[/COLOR] Range
    [COLOR=Blue]Dim[/COLOR] rngTarget [COLOR=Blue]As[/COLOR] Range
    
    [COLOR=Blue]Set[/COLOR] shSource = Worksheets("Mike")
    [COLOR=Blue]Set[/COLOR] shTarget = Worksheets("Sheet1")
    [COLOR=Blue]Set[/COLOR] rngSource = shSource.Range("D3:U17")
    
    [COLOR=Blue]With[/COLOR] shTarget
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        rngSource.Copy
        .Cells(lastRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
    [COLOR=Blue]End[/COLOR] [COLOR=Blue]With[/COLOR]

[COLOR=Blue]End[/COLOR] [COLOR=Blue]Sub[/COLOR]

thxs Sektor...worked like a charm

mike

 

[mikesal57]

one last thing....

in this range there can be blank rows....

how can I NOT add them to the data list?

mike

 

[mikesal57]

remove blank rows..... anyone?

 

[mikesal57]

Sektor...anyway to incorporate no blanks in this sub?