VBA Shift One Row Down.

Hi all,

As the title states there is a section in my code where I am having a problem shifting the pasted data a row down below the previously pasted data.

Essentially the code will cycle through worksheets and select data to populate a table on "Sheet 2" by finding "Hello" on the worksheet and taking the range below it until there is "" (no cell value).

The actual problem comes from the last line "clientcounter = clientcounter + 1" - this pastes the data 1 column across, however I am trying to paste this 1 row down.

I have indented where I believe the problem stems from - this part of the code I think isn't actually necessary (I took this code from a similar one I had written).

If you know how to quickly fix this so that the data is pasted 1 row below please let me know!

Code:

---

Sub TablePopulate()


Dim sheetcount As Integer
Dim i As Integer


Sheets("Sheet2").Activate
Range(Cells(12, 2), Cells(16, 8)).ClearContents


sheetcount = ActiveWorkbook.Worksheets.Count


clientcounter = 2


For i = 1 To sheetcount


    If ActiveWorkbook.Sheets(i).Name <> "Sheet2" Then
   
        ActiveWorkbook.Sheets(i).Activate
       
        'Cells(2, 3).Activate
        'clientname = Cells(2, 3)
       
        'Cells(2, 3).Copy
       
       
        datarow_start = 1
        datarow_end = 1
        For j = 1 To 1000
       
            If Cells(j, 2) = "Hello" Then
           
                datarow_start = j + 1
           
               
                Exit For
               
            End If
       
        Next j
       
        If datarow_start <> 1 Then
       
            For g = datarow_start To datarow_start + 50
           
                If Cells(g, 2) = "" Then
               
                On Error Resume Next
                       
                    datarow_end = g - 1
                    Exit For
                   
                End If
           
            Next g
           
            Range(Cells(datarow_start, 2), Cells(datarow_end, 7)).Select
            Selection.Copy
       
        End If
       
        Sheets("Sheet2").Activate
       
        Cells(12, clientcounter) = clientname
       
        Cells(12, clientcounter).Select
       
        If datarow_start <> 1 Then
            Selection.PasteSpecial xlPasteValues
        End If
       
             
        clientcounter = clientcounter + 1
       
   
    End If


Next i




End Sub

---

Thanks in advance.

Code:

---

Option Explicit

Sub TablePopulate()
    Dim Sht As Worksheet
    Dim StartCel As Range
    Dim EndCel As Range
    Dim Sht2 As Worksheet
    Set Sht2 = Sheets("Sheet2")
   
    'Clear to bottom of data
    Sht2.Range(Range("B12"), Range("H12").End(xlDown)).ClearContents
   
    For Each Sht In Worksheets 'Worksheets is a part of Sheets
      If Sht Is Sht2 Then GoTo SkipSht
     
      Set StartCel = Sht.Columns(2).Find(FindWhat:="Hello", _
                  After:=Range("B1"), SearchDirection:=xlNext)
      If StartCel Is Nothing Then GoTo SkipSht 'Didn't find "hello"
     
      'Set startCel = 6 columns to right and down to bottom of data
      Set EndCel = StartCel.Offset(, 6).End(xlDown)
     
      'copy to the cell below the bottom of data in Column B
      Range(StartCel, EndCel).Copy Sht2.Cells(Rows.Count, "B").End(xlUp).Offset(1)
     
SkipSht: '<--- Note Colon. Needed for GoTo
    Next Sht
End Sub

---

Quote:

---

Originally Posted by SamT

Code:

---


      Set StartCel = Sht.Columns(2).Find(FindWhat:="Hello", _
                  After:=Range("B1"), SearchDirection:=xlNext)

---

---

Hi SamT, thank you for your quick response.

The part of the code I have highlighted is creating a run time error (named argument not found). I believe the issue is that it's saying "StartCel = nothing". Do you know why this is occurring? (Apologies for my inexperience here).

Code:

---

Sub TablePopulate()
    Dim Sht As Worksheet
    Dim StartCel As Range
    Dim EndCel As Range
    Dim Sht2 As Worksheet
    Set Sht2 = Sheets("Sheet2")
   
    Sht2.Range(Cells(12, 2), Cells(12, 8).End(xlDown)).ClearContents
   
    For Each Sht In Worksheets
        If Sht Is Sht2 Then GoTo SkipSht
        Set StartCel = Sht.Columns(2).Find("Hello")
        If StartCel Is Nothing Then GoTo SkipSht
       
        Set EndCel = StartCel.Offset(, 6).End(xlDown)
       
        Range(StartCel, EndCel).Copy Sht2.Cells(Rows.Count, "B").End(xlUp).Offset(1)
       
SkipSht:
    Next Sht
End Sub

---