VBA that will copy values from one sheet to several sheets

[Ron512]

Hi, your assistance please. I have a workbook with a sheet named “List” and several other sheets. Sheet List has values in column B that I want copied to cell D2 on all the sheet in the workbook that follows the sheet List.

For example, the value in the sheet List cell B1 is copied to cell D2 in the first sheet after List, the value in B2 is copied to cell D2 in the next sheet. That will continue until for all sheets.

Thanks
Ron

 

[rollis13]

Here is how would do it without using a macro:
- Copy the cells in column B of sheet 'List' then
- Select the first tab on the right of List then
- hold down CTRL key then
- Right-Click a tab then
- choose Select All Tabs then
- Click the 'List's tab to unselect it then
- release CTRL key and finally
- Paste in D2 of a selected sheet.

 

[Farscape2020]

If you are still looking for vba code, you could try:

Public Sub copyValues()

    Dim columnArray As Variant
    Dim i, j As Integer
    
    For i = 1 To Sheets.Count
        
        If Sheets(i).Name = "List" Then
        
            columnArray = Sheets(i).Range("B1:B" & Sheets(i).Cells(Rows.Count, 2).End(xlUp).Row)
            
            For j = LBound(columnArray) To UBound(columnArray)
            
                Sheets(i + j).Range("D2").Value = columnArray(j, 1)
            
            Next j
    
            Exit For
        
        End If
    
    Next i

End Sub

I have not added any error checks that may include if there are more cells in the B column, of the Lists worksheet, than the number of worksheets that follow it.

 

[Ron512]

Farscape2020,

Thanks for the quick reply. It works perfectly although I have a change. I’m not familiar with array coding so I’m having trouble adjusting the code myself.
The copy to each of the sheets will be implemented after a sheet call “Index”. There could be sheets before and after the Index sheet.

Ron

 

[Farscape2020]

Farscape2020,

Thanks for the quick reply. It works perfectly although I have a change. I’m not familiar with array coding so I’m having trouble adjusting the code myself.
The copy to each of the sheets will be implemented after a sheet call “Index”. There could be sheets before and after the Index sheet.

Ron

Hi Ron,

The code provided will begin iterating through the worksheets until it identifies the worksheet named "List" (or you can change the name to index). Once it identifies this worksheet, it creates an array of the values in column B. As it iterates through this array, it will add the value in cell B1 to cell D2 in the first sheet after the "List" worksheet. Then it will add the value in B2 to cell D2 in the second worksheet after the "List" worksheet. The value in B3 will be added to D2 in the third worksheet after the "List" worksheet, and so on. If there are worksheets before the "List" worksheet then the macro will ignore them. The only thing I did not account for was what would happen if there are not the correct number of worksheets after the "List" worksheet. For instance, in the "List" worksheet, column B has 5 values but there are only four worksheets after the "List" worksheet. Do you forsee this being an issue?

 

[Ron512]

Hey Farscape2020,

Thanks for the additional information. I was not clear in my description.
An example of a workbook the sheets would be laid out as such:
List, Sheet1, Sheet2, Index, Sheet3, Sheet4
The copy would take place in the sheets always after the sheet “Index”. I was planning to make the change after getting a start from the experts on this forum although the array code threw me off. I was able to adjusted your code to work with a Sheet named Index. The code is below. Although it works, I am open to a critique and recommendations on improving. I will add in error checking.

Ron

Public Sub copyValues()
Dim columnArray As Variant
Dim i, j As Integer
Dim IndexSht As Integer

For i = 1 To Sheets.Count

IndexSht = Sheets("Index").Index + 1

If Sheets(i).Name = "List" Then

   columnArray = Sheets(i).Range("B1:B" & Sheets(i).Cells(Rows.Count, 2).End(xlUp).Row)

   For j = LBound(columnArray) To UBound(columnArray)

      Sheets(IndexSht).Range("D2").Value = columnArray(j, 1)

      IndexSht = IndexSht + 1

    Next j

Exit For

End If

Next i

End Sub