Finding the next row when there are blanks in the previous row

[Suduah]

Hello i am trying to figure out how to paste a range of cells on to the next row when there are a few blanks in the row above. My code keeps overwriting them.
Here is my code:

Sub GetSheetstest()
    
       Dim Path As String
       Dim FileName As String
       Dim Sheet As Worksheet
       Dim pasteRow As Integer
    
       pasteRow = 2
    
      With Application
               .ScreenUpdating = False
            .EnableEvents = False
        End With
        
    Windows("Summary Data v4.xlsm").Activate
     
     With Sheets("Sheet1")
        .Rows(2 & ":" & .Rows.Count).Delete
    End With
    
    
    Path = "C:\blahz"
    FileName = Dir(Path & "*.xlsm")
    Do While FileName <> ""
        Workbooks.Open FileName:=Path & FileName, ReadOnly:=True
          
        Sheets("Case Summary").Range("B2:B46").Copy
        Windows("Summary  Data v4.xlsm").Activate
          
        Range("A" & pasteRow).End(xlUp).Offset(1).Select
    
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
            
        
         Workbooks(FileName).Activate
        
        Sheets("pear").Range("B2:B5").Copy
        Windows("Summary Data v4.xlsm").Activate
          
       Range("AT" & pasteRow).End(xlUp).Offset(1).Select
    
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
            
          
             Workbooks(FileName).Activate
        
        Sheets(" apple").Range("B2:B18").Copy
        Windows("Summary  Data v4.xlsm").Activate
          
       Range("AX" & pasteRow).End(xlUp).Offset(1).Select
    
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
         
     
        
           Workbooks(FileName).Activate
        
        Sheets("orange").Range("B2:B22").Copy
        Windows(" Summary data v4.xlsm").Activate
          
       Range("BO" & pasteRow).End(xlUp).Offset(1).Select
    
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=True
            
          pasteRow = pasteRow + 1
         
        Workbooks(FileName).Close
        FileName = Dir()
        
        
       
    Loop
    
    With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    
    End Sub

For example, for the sheet pear the majority of the time the range B2:B5 is empty but if there is a value instead of going on the correct row matching its refe it goes to the top row at the beginning of the spreadsheet since are all the rows above are blank.

 

[Suduah]

Someone helped me already. So no need to answer the question

 

[Joe4]

Someone helped me already.

Where? Have you posted this question on other forums too?
Would you find posting the result so others can see (in case someone else searches for a similar problem and comes across this thread)?

 

[Fluff]

seen post#2

 

[Suduah]

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; font-style: inherit; font-variant-caps: inherit; line-height: inherit; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Sub GetSheetstest()

Const F_PATH As String = "C:\blahz"
Dim FileName As String, shtDest As Worksheet, wb As Workbook, pasteRow As Long

Set shtDest = Workbooks("Summary Data v4.xlsm").Sheets("Sheet1")
shtDest.Rows(2 & ":" & shtDest.Rows.Count).Delete

pasteRow = 2
FileName = Dir(F_PATH & "*.xlsm")
Do While FileName <> ""

Set wb = Workbooks.Open(FileName:=F_PATH & FileName, ReadOnly:=True)

CopyTranspose wb.Sheets("Case Summary").Range("B2:B46"), shtDest.Cells(pasteRow, "A")
CopyTranspose wb.Sheets("pear").Range("B2:B5"), shtDest.Cells(pasteRow, "AT")
CopyTranspose wb.Sheets("apple").Range("B2:B18"), shtDest.Cells(pasteRow, "AX")
CopyTranspose wb.Sheets("orange").Range("B2:B22"), shtDest.Cells(pasteRow, "BO")

pasteRow = pasteRow + 1

wb.Close
Loop
End Sub

'utility: copy a range's values (transposed) to another location
Sub CopyTranspose(rngCopy As Range, rngDest As Range)
rngDest.Resize(rngCopy.Columns.Count, rngCopy.Rows.Count).Value = _
Application.Transpose(rngCopy.Value)
End Sub

This is the code that someone else helped me with

</code>

 

[Suduah]

Thank you for writing the code. I tried to delete the post but i was unable to. Sorry for any inconvenience caused.

 

[Joe4]

Note that if you are posting the question to multiple forums, this is known as "Cross-Posting". While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.