Macro to verify cells and copy past values, Help!

[naviero1]

Good morning everyone,
I have these extraction on a sheet, let's call it "main" sheet. I have formulas on P5:Q1000 that depend on the extraction and change constantly every time the extraction is refreshed. So I am trying to find a way (through a macro push button) to copy past the new refreshed values from those two columns and paste them on another sheet called "dumper". Dumper might have other data that has been extracted before, so this macro would need to acknowledge that by checking which is the last value entered and hence, paste (values) the new values right underneath. Then get me back to the main sheet.

Sub filedumping()
'copia linha inteira com criterio
Dim i As Range
For Each i In Range("P5:P1000")
If i.Value > 0 Then
i.Select

'I think i need a Formula to select values from both row p and row q
'for every iteration



Selection.Copy
Sheets("Dumper").Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

End If
Next i
End Sub

this is what I have so far, I would very much appreciate your input

 

[naviero1]

This is a way faster and better formula than the one I have, but it still doesnt do a good job at keeping the dumper file tidy and in order, without the 0s.
Is there a way that it can copy only the values that are <> than "" or 0 and then organize them in such a way that there arent spaces between them on the dumper sheet?

I think I understand now.

Try:

Public Sub CopyFileDump()
Dim LR      As Long

Dim sWS     As Worksheet, _
    dWS     As Worksheet
    
Dim rng     As Range, _
    rowx    As Long, _
    coly    As Long

Set sWS = ActiveSheet
Set dWS = Sheets("dumper")

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

LR = WorksheetFunction.Max(dWS.Range("A" & Rows.Count).End(xlUp).Row + 1, dWS.Range("B" & Rows.Count).End(xlUp).Row + 1)
rowx = LR
For Each rng In sWS.Range("P5:P300")
    If Len(rng.Value) > 0 Then
        rng.Resize(1, 2).Copy
        dWS.Range("A" & rowx).PasteSpecial xlPasteValues
        rowx = rowx + 1
    End If
Next rng

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .CutCopyMode = False
End With

End Sub

 

[MrKowz]

Can you please provide some sample data with desired output? Each time you post, your wording on the criteria is changing, and I'm honestly getting confused.

 

[naviero1]

Ok:
So lets say that on the dumper sheet columns A and B you had these:

A B
12D 23R
34f f21
fg3 j212
0 0
I want the pasting from the "main" sheet to be pasted each time i run this macro right below fg3 and j212 respectively from columns P and Q, avoiding the 0s as well so its just continued data. Does that make any sense ?
It is not doing that, it is pasting even the data that i dont need suck as 0 and fake blank cells.

 

[MrKowz]

Using the following sample data, I was able to generate the following output after running it 3 times. Is this what you're looking for?

Sample Data:

Excel 2013/2016
	P	Q
5	ABC123	XYZ929
6	0	0
7	JKL567	MNO876
8	GHI999	FGH888
9
10	CDE345	TUV321
Sheet1

Output:

Excel 2013/2016
	A	B
2	ABC123	XYZ929
3	JKL567	MNO876
4	GHI999	FGH888
5	CDE345	TUV321
6	ABC123	XYZ929
7	JKL567	MNO876
8	GHI999	FGH888
9	CDE345	TUV321
10	ABC123	XYZ929
11	JKL567	MNO876
12	GHI999	FGH888
13	CDE345	TUV321
dumper

Code:

Public Sub CopyFileDump()
Dim LR      As Long

Dim sWS     As Worksheet, _
    dWS     As Worksheet
    
Dim rng     As Range, _
    rowx    As Long, _
    coly    As Long

Set sWS = ActiveSheet
Set dWS = Sheets("dumper")

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

LR = WorksheetFunction.Max(dWS.Range("A" & Rows.Count).End(xlUp).Row + 1, dWS.Range("B" & Rows.Count).End(xlUp).Row + 1)
rowx = LR
For Each rng In sWS.Range("P5:P300")
    If Len(rng.Value) > 0 And rng.Value <> 0 Then
        rng.Resize(1, 2).Copy
        dWS.Range("A" & rowx).PasteSpecial xlPasteValues
        rowx = rowx + 1
    End If
Next rng

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .CutCopyMode = False
End With

End Sub

 

[naviero1]

Ah you're the man MrKowz, sorry for being such a pain in the ***. That worked awesome though. You have no idea how much I appreciate it! What an awesome community this site has.

 

[MrKowz]

Ah you're the man MrKowz, sorry for being such a pain in the ***. That worked awesome though. You have no idea how much I appreciate it! What an awesome community this site has.

Happy to be of service, and glad it works out for you. Have a great day!