PDA

View Full Version : VBA Shift One Row Down.



patricevease
01-18-2016, 04:14 AM
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!


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.

SamT
01-18-2016, 05:03 AM
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

patricevease
01-18-2016, 06:33 AM
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).

SamT
01-18-2016, 01:15 PM
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