Macro to fill blank cells in multiple worksheets with values in a cell range in respect to each worksheet

[Ay Sticky]

I have a 2 column data with varying number of rows across the worksheets. All values in each worksheets are different and independent. The data consist of blank spaces and for each row with blank space, there are no values across their 2 columns. Now I need a VBA to copy the values in row 1 (the values are in 2 columns) and insert into the blank rows until the last blank row before the last row with data. And I want this to process across all worksheets minding that the data in these worksheets differs from each other.

For example
A B
1 4.4 5.4
2
3
4 4.2 6.7

Row 2 and 3 consist of blank spaces and I need fill in their respective 2 empty columns with values from row 1 (A1:B1). Also the fillings should not exceed the last blank row before the last row with data, that is row 4.

This should be done to the all worksheets in respect to the values in their first row to be used in filling their blank spaces.

 

[maabadi]

Please upload example data and Desired result with method I posted below of my post.

 

[Ay Sticky]

 

[maabadi]

Try this:

Sub Test()
Dim i As Long, j As Long, K As Long, St As String, Lr As Long, Ws As Worksheet
For Each Ws In Worksheets
Lr = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To Lr - 1
If Ws.Range("A" & i + 1).Value = "" Then
K = Ws.Range("A" & i).End(xlDown).Row - 1
Ws.Range("A" & i + 1 & ":B" & K).Value = Ws.Range("A" & i & ":B" & i).Value
i = K
End If
Next i
End Sub

 

[Ay Sticky]

Try this:

Sub Test()
Dim i As Long, j As Long, K As Long, St As String, Lr As Long, Ws As Worksheet
For Each Ws In Worksheets
Lr = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To Lr - 1
If Ws.Range("A" & i + 1).Value = "" Then
K = Ws.Range("A" & i).End(xlDown).Row - 1
Ws.Range("A" & i + 1 & ":B" & K).Value = Ws.Range("A" & i & ":B" & i).Value
i = K
End If
Next i
End Sub

Running the above code, I got a dialog box display error that displays as below.

Compile error:
For without Next

 

[maabadi]

Sorry my fault. After Next i Line add:

Next Ws

 

[Ay Sticky]

The code runs well now, but did not do the job. Instead, it was filling those blank rows with values above each blanks. I only intend to fill those blanks with values present in first row only. That is, using values in A1:B1 to fill all the blank rows. The blank rows are very much, more than just the 4 rows in the screenshot I posted earlier. For example in worksheet (1), I may have up to 500 rows of data inclusive of these empty rows.

 

[maabadi]

if you want only all Blank Cells with Row 1 Data Try this:

Sub Test()
Dim i As Long, j As Long, K As Long, St As String, Lr As Long, Ws As Worksheet
For Each Ws In Worksheets
Lr = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To Lr - 1
If Ws.Range("A" & i + 1).Value = "" Then
K = Ws.Range("A" & i).End(xlDown).Row - 1
Ws.Range("A" & i + 1 & ":B" & K).Value = Ws.Range("A1:B1").Value
i = K
End If
Next i
Next Ws
End Sub

 

[Ay Sticky]

if you want only all Blank Cells with Row 1 Data Try this:

Sub Test()
Dim i As Long, j As Long, K As Long, St As String, Lr As Long, Ws As Worksheet
For Each Ws In Worksheets
Lr = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To Lr - 1
If Ws.Range("A" & i + 1).Value = "" Then
K = Ws.Range("A" & i).End(xlDown).Row - 1
Ws.Range("A" & i + 1 & ":B" & K).Value = Ws.Range("A1:B1").Value
i = K
End If
Next i
Next Ws
End Sub

This worked perfectly! Thank you many times.

 

[maabadi]

You're Welcome & Thanks for Follow-up.