Code keeps pasting values over existing rows, Unable to paste value from empty row below

[tarallox]

Dear all,

I've been looking for quite a while now.. I've been trying to copy and paste VALUE from worksheets (All except TEST), into the "MasterSheet".
Other worksheets have formulas from A15 : A50 - and I'm trying to only copy and paste the values that are not " ". (i.e. if empty, move onto next worksheet and copy from a15 - a x).

i've tried using the code below so far, I can see my formulas / data come out but it's getting overwritten by the final worksheets data (meaning instead of 4 pages of work stacked, it's 1 as the rest have been deleted).

Can someone help me? Any guidance is super appreciated..

Sub copypaste()


Sheets("MasterSheet").Select
Range("A20:A1000").Select
Selection.ClearContents

Dim J As Integer
Dim sh As Worksheet
Const excludeSheets As String = "test"

On Error Resume Next
For Each sh In ActiveWorkbook.Worksheets

If IsError(Application.Match(sh.Name, Split(excludeSheets, ","))) Then
        Application.GoTo Sheets(sh.Name).[b3]
        Range("A13:A50").Select
        Selection.Copy
       Worksheets("MasterSheet").Activate
    Range("a1").End(xlUp).Offset(rowOffset:=10, columnOffset:=2).PasteSpecial xlPasteValues
    End If
   
Next
Application.CutCopyMode = False
MsgBox "Master Updated"

End Sub

 

[tarallox]

Alternatively if you think a better code can be written..

I'm trying to do this

1) Copy and paste only non " " values from worksheets (1,2,3), cells A20-A100,
2) Paste values into MasterSheet from B11 and down

 

[KansaiDorifto]

How do you want the data to show up in the MasterSheet? As a single column starting B11?

 

[tarallox]

Hey there,

yes just a single column from b11 down..

 

[Alex Blakenburg]

Give this a try:

Sub copypaste_mod()

    Dim arrExcludeSheets As Variant
    Dim wb As Workbook
    Dim mstrSht As Worksheet
    Dim sh As Worksheet
    Dim copyRng As Range
    Dim destRng As Range
    Dim destRngNonBlank As Range
    Dim i As Long
    Dim arr() As Variant
    Dim rCell As Range
    
    arrExcludeSheets = Array("test", "MasterSheet")
    Set wb = ThisWorkbook
    Set mstrSht = wb.Sheets("MasterSheet")
    mstrSht.Range("B11:B" & mstrSht.Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
    
    On Error Resume Next
    For Each sh In wb.Worksheets
    
        If IsError(Application.Match(sh.Name, arrExcludeSheets, 0)) Then
            'Set copyRng = sh.Range("A15:A" & sh.Cells(Rows.Count, "A").End(xlUp).Rows)
            Set copyRng = sh.Range("A15:A50")
            Set destRng = mstrSht.Cells(Rows.Count, "B").End(xlUp).Offset(1)
            If destRng.Row < 11 Then Set destRng = mstrSht.Range("B11")
            destRng.Resize(copyRng.Rows.Count).Value = copyRng.Value
        End If
        
    Next
    
    Set destRng = mstrSht.Range("B11:B" & mstrSht.Cells(Rows.Count, "B").End(xlUp).Row)
    Set destRngNonBlank = destRng.SpecialCells(xlCellTypeConstants)
    
    ReDim arr(1 To destRngNonBlank.Cells.Count, 1 To 1)
    
    i = 0
    For Each rCell In destRngNonBlank
        i = i + 1
        arr(i, 1) = rCell.Value
    Next rCell
    
    destRng.ClearContents
    destRng.Resize(UBound(arr, 1)).Value = arr

    MsgBox "Master Updated"

End Sub

 

[tarallox]

Hey Alex,

ahh this works perfectly, thank you so much!! Super appreciate it

 

[Alex Blakenburg]

Glad I could help and appreciate the feedback.