Paste to next blank row

[Donald Leigh]

Hi all

I have this code below. It all works except its not finding the next blank row because column A is always blank. When I run the code it always copies over the last data that was pasted. I need to find the next blank row. The row above this could have data in any column

Any help would be great


Sub Merge_Sheets()
Dim startRow, startCol, lastrow, lastCol As Long
Dim headers As Range
'Set Master sheet for consolidation
Set mtr = Worksheets("REMITTANCE TEMPLATE")
Set wb = ThisWorkbook
'Get Headers
Set headers = Application.InputBox("Select the Headers", Type:=8)
'Copy Headers into master
headers.Copy mtr.Range("A1")
startRow = headers.Row + 1
startCol = headers.Column
Debug.Print startRow, startCol
'loop through all sheets
For Each ws In wb.Worksheets
'except the master sheet from looping
If ws.Name = "Master" Then
ElseIf ws.Name = "INSTRUCTIONS" Then
ElseIf ws.Name = "VENDOR MASTER DATA" Then
ElseIf ws.Name = "PMT MASTER DATA" Then
ElseIf ws.Name = "REMITTANCE TEMPLATE" Then
Else
ws.Activate
Rows("18:36").Select
Selection.Copy
Worksheets("Master").Activate
Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Offset(RowOffset:=1). _
PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
End If
Next ws
Worksheets("Master").Activate
End Sub

 

[Anthony47]

In your macro, replace from For Each ws In wb.Worksheets to End Sub with this code:

Worksheets("Master").Activate
For Each ws In WB.Worksheets
    'except the master sheet from looping
    If ws.Name <> "Master" Then
        On Error Resume Next
        LastR = Range("A:Z").Find(What:="*", After:=[A1], _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious).Row
        On Error GoTo 0
        ws.Rows("18:36").Copy
        Cells(LastR + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
          SkipBlanks:=True, Transpose:=False
    End If
Next ws
Application.CutCopyMode = False
End Sub

Bye