Hello,

Sheet3 has data input Dates - B8:B15, Description - D8:D15, & Type -
E8:E16 I need the script to loop through these cells if there is data
in them to insert that data in Sheet2 next blank row.

The macro below will insert data for B8, D8, & E8 but will not for the
other cells that have data. So how can this macro be modified to loop
through Sheet3 cells B8:B15, D8:D15, & E8:E16 and insert the data in
Sheet2 next blank rows?

Sub FindBlankRowInsertData()
Dim lastrow As Object
Dim currentWorkbook As Workbook
Dim WS As Worksheet

With currentWorkbook
Set lastrow = Sheet2.Range("a65536").End(xlUp)
Set WS = Sheet3
'write the data to the new sheets
lastrow.Offset(1, 0) = WS.Range("D8:D15").Value
lastrow.Offset(1, 1) = WS.Range("B8:B15").Value
lastrow.Offset(1, 2) = WS.Range("E8:E15").Value
End With

End Sub

Thank you for your help,
jfcby

jfcby wrote:

'write the data to the new sheets
lastrow.Offset(1, 0) = WS.Range("D8:D15").Value
lastrow.Offset(1, 1) = WS.Range("B8:B15").Value
lastrow.Offset(1, 2) = WS.Range("E8:E15").Value

Replace this section with:

i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = ws.Range("b8").Offset(k, j - 1)
Next
i = i + 1
Next


Nik

Hello Nik,

I have two questions:

1. Could you explain how this code works I learning VBA and I do not
understand how it works to make changes when needed?
i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = ws.Range("b8").Offset(k, j - 1)
Next
i = i + 1
Next

2. When I put your modified code in the code below it puts the data in
the wrong place.

Sheet3 data is setup like so
B D
E
8 Dates Description Type
9 1/2/2006 New Years Day H
10 4/15/2006 Martin Luther King Day WH
11 8/21/2006 Memorial Day B
12 12/25/2006 Christmas Day O

Sheet2 data is setup like so
A2 B2 C2
Description Date Type

When I run your code it puts the description in column b in the last
row of data instead of the last blank row begining in column A. I would
like for sheet3 columnB data inserted in sheet2 columnB, sheet3 columnD
data inserted in sheet2 columnA, and sheet3 columnE data inserted in
sheet2 columnC.

This is the modified code:

Sub FindBlankRowInsertData2()
Dim lastrow As Object
Dim currentWorkbook As Workbook
Dim WS As Worksheet

With currentWorkbook
Set lastrow = Sheet2.Range("a65536").End(xlUp)
Set WS = Sheet3
'write the data to the new sheets
i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = WS.Range("B8").Offset(k, j - 1)
Next
i = i + 1
Next

End With

End Sub

Thank you for your help,
jfcby

Nik wrote:
jfcby wrote:

'write the data to the new sheets
lastrow.Offset(1, 0) = WS.Range("D8:D15").Value
lastrow.Offset(1, 1) = WS.Range("B8:B15").Value
lastrow.Offset(1, 2) = WS.Range("E8:E15").Value

Replace this section with:

i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = ws.Range("b8").Offset(k, j - 1)
Next
i = i + 1
Next


Nik

Hello Nik,

I have two questions:

1. Could you explain how this code works I learning VBA and I do not
understand how it works to make changes when needed?
i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = ws.Range("b8").Offset(k, j - 1)
Next
i = i + 1
Next

2. When I put your modified code in the code below it puts the data in
the wrong place.

Sheet3 data is setup like so
B D
E
8 Dates Description Type
9 1/2/2006 New Years Day H
10 4/15/2006 Martin Luther King Day WH
11 8/21/2006 Memorial Day B
12 12/25/2006 Christmas Day O

Sheet2 data is setup like so
A2 B2 C2
Description Date Type

When I run your code it puts the description in column b in the last
row of data instead of the last blank row begining in column A. I would
like for sheet3 columnB data inserted in sheet2 columnB, sheet3 columnD
data inserted in sheet2 columnA, and sheet3 columnE data inserted in
sheet2 columnC.

This is the modified code:

Sub FindBlankRowInsertData2()
Dim lastrow As Object
Dim currentWorkbook As Workbook
Dim WS As Worksheet

With currentWorkbook
Set lastrow = Sheet2.Range("a65536").End(xlUp)
Set WS = Sheet3
'write the data to the new sheets
i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = WS.Range("B8").Offset(k, j - 1)
Next
i = i + 1
Next

End With

End Sub

Thank you for your help,
jfcby

Nik wrote:
jfcby wrote:

'write the data to the new sheets
lastrow.Offset(1, 0) = WS.Range("D8:D15").Value
lastrow.Offset(1, 1) = WS.Range("B8:B15").Value
lastrow.Offset(1, 2) = WS.Range("E8:E15").Value

Replace this section with:

i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = ws.Range("b8").Offset(k, j - 1)
Next
i = i + 1
Next


Nik

Hello Nik,

I have two questions:

1. Could you explain how this code works I learning VBA and I do not
understand how it works to make changes when needed?
i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = ws.Range("b8").Offset(k, j - 1)
Next
i = i + 1
Next

2. When I put your modified code in the code below it puts the data in
the wrong place.

Sheet3 data is setup like so
B D
E
8 Dates Description Type
9 1/2/2006 New Years Day H
10 4/15/2006 Martin Luther King Day WH
11 8/21/2006 Memorial Day B
12 12/25/2006 Christmas Day O

Sheet2 data is setup like so
A2 B2 C2
Description Date Type

When I run your code it puts the description in column b in the last
row of data instead of the last blank row begining in column A. I would
like for sheet3 columnB data inserted in sheet2 columnB, sheet3 columnD
data inserted in sheet2 columnA, and sheet3 columnE data inserted in
sheet2 columnC.

This is the modified code:

Sub FindBlankRowInsertData2()
Dim lastrow As Object
Dim currentWorkbook As Workbook
Dim WS As Worksheet

With currentWorkbook
Set lastrow = Sheet2.Range("a65536").End(xlUp)
Set WS = Sheet3
'write the data to the new sheets
i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = WS.Range("B8").Offset(k, j - 1)
Next
i = i + 1
Next

End With

End Sub

Thank you for your help,
jfcby

Nik wrote:
jfcby wrote:

'write the data to the new sheets
lastrow.Offset(1, 0) = WS.Range("D8:D15").Value
lastrow.Offset(1, 1) = WS.Range("B8:B15").Value
lastrow.Offset(1, 2) = WS.Range("E8:E15").Value

Replace this section with:

i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = ws.Range("b8").Offset(k, j - 1)
Next
i = i + 1
Next


Nik

Hello Nik,

I apologize for the multiple post but I got a error message when I
tried to post my message and did not relize my message posted anyway.
I'm sorry!

I kept working with the code and got it work. Thank you for your help!

Working Code:

Sub FindBlankRowInsertData2()
Dim lastrow As Object
Dim currentWorkbook As Workbook
Dim WS As Worksheet

With currentWorkbook
Set lastrow = Sheet2.Range("a65536").End(xlUp).Offset(1, 0)
Set WS = Sheet3
'write the data to the new sheets
i = 0
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = WS.Range("B8").Offset(k, j - 1)
Next
i = i + 1
Next
End With
End Sub

jfcby

Nik wrote:
jfcby wrote:

'write the data to the new sheets
lastrow.Offset(1, 0) = WS.Range("D8:D15").Value
lastrow.Offset(1, 1) = WS.Range("B8:B15").Value
lastrow.Offset(1, 2) = WS.Range("E8:E15").Value

Replace this section with:

i = 1
For Each j In Array(3, 1, 4)
For k = 0 To 7
lastrow.Offset(k, i) = ws.Range("b8").Offset(k, j - 1)
Next
i = i + 1
Next


Nik