Small Script Edit - Pasting value in front of data set

[patricevease]

Hi all.

I currently have a script that will run through my workbook and copy data from specific tables on each page and paste it in to one main worksheet (BusDeV). Here is the script for this:


Sub TablePopulate2()


Dim sheetcount As Integer
Dim i As Integer


Sheets("BusDev").Activate
Range(Cells(11, 2), Cells(1000, 9)).ClearContents


sheetcount = ActiveWorkbook.Worksheets.Count


clientcounter = 2


For i = 1 To sheetcount


If ActiveWorkbook.Sheets(i).Name <> "HighViewRemakeTest" And ActiveWorkbook.Sheets(i).Name <> "ClientTemplate" And ActiveWorkbook.Sheets(i).Name <> "ClientTemplateBackup" And ActiveWorkbook.Sheets(i).Name <> "Lists" And ActiveWorkbook.Sheets(i).Name <> "BusDev" And ActiveWorkbook.Sheets(i).Name <> "Overview" 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) = "Business development activities" Then

datarow_start = j + 2


Exit For

End If

Next j

If datarow_start <> 2 Then

For g = datarow_start To datarow_start + 50

If Cells(g, 2) = "" Then

On Error Resume Next

datarow_end = g
Exit For

End If

Next g

Range(Cells(datarow_start, 2), Cells(datarow_end, 8)).Select
Selection.Copy

End If

Sheets("BusDev").Activate


k = 12
For k = 11 To 10000

If Cells(k, 2) = "" Then
Exit For
End If

Next k

clientcounter = k

Cells(clientcounter, 2).Select

If datarow_start <> 1 Then
Selection.PasteSpecial xlPasteValues
End If

End If

Next i




End Sub




What I am struggling with is the part I have excluded from the code above (using ' ). This will take the 'client name' from cells (2,3) of each sheet of the tables however I need this to be pasted in a column before the rows of data is pasted later in the script.

Without changing the main script could anyone please help me add in a code to paste this Client Name in front of the data being pasted? Thanks!

[snb]

This should be sufficient:


Sub M_snb()
Sheets("BusDev").Cells(11, 2).Resize(989, 8).ClearContents

For Each sh In Sheets
If InStr("|HighViewRemakeTest|ClientTemplate|ClientTemplateBackup|BusDev|Overview|", "|" & sh.Name & "|") = 0 Then
With sh.Cells(1).CurrentRegion
Sheets("BusDev").Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count) = .Value
End With
End If
Next
End Sub