Copies of the list box with the addition of an empty row between the rows

S

sofas

Active Member
Joined
Sep 11, 2022
Messages
468
Office Version
  1. 2019
Platform
  1. Windows
Hello. How do I modify the code to leave a blank row between each row with values when copying to an Excel sheet


VBA Code: 
Dim i As Long
With ListBox5
ReDim a(0 To .ListCount - 1, 1 To 12)
For i = 0 To .ListCount - 1
a(i, 1) = .List(i, 0)
 a(i, 2) = .List(i, 1)
  a(i, 3) = .List(i, 3)
    a(i, 4) = .List(i, 4)
      a(i, 5) = .List(i, 16)
       a(i, 6) = .List(i, 5)
        a(i, 7) = .List(i, 7)
         a(i, 8) = .List(i, 8)
          a(i, 9) = .List(i, 9)
           a(i, 10) = .List(i, 11)
            a(i, 11) = .List(i, 12)
             a(i, 12) = .List(i, 13)
 Next
 
  End With
  
sh.Range("A7").Resize(UBound(a, 1) + 1, UBound(a, 2)).Value = a
 

Attachments

  • 1.PNG
    1.PNG
    20.3 KB · Views: 5

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
Hi @sofas.

Try the following code.
Note: I made some adjustments to your code, please check them:
VBA Code: 
  Dim j As Long
  j = 1
  With ListBox5
    ReDim a(1 To .ListCount, 1 To 12)
    For i = 0 To .ListCount - 1
      a(j, 1) = .List(i, 0)
      a(j, 2) = .List(i, 1)
      a(j, 3) = .List(i, 3)
      a(j, 4) = .List(i, 4)
      a(j, 5) = .List(i, 16)
      a(j, 6) = .List(i, 5)
      a(j, 7) = .List(i, 7)
      a(j, 8) = .List(i, 8)
      a(j, 9) = .List(i, 9)
      a(j, 10) = .List(i, 11)
      a(j, 11) = .List(i, 12)
      a(j, 12) = .List(i, 13)
      j = j + 1
    Next
  End With
  
  sh.Range("A7").Resize(UBound(a, 1), UBound(a, 2)).Value = a

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------
 
Upvote 0
DanteAmor said:
Hi @sofas.

Try the following code.
Note: I made some adjustments to your code, please check them:
VBA Code: 
  Dim j As Long
  j = 1
  With ListBox5
    ReDim a(1 To .ListCount, 1 To 12)
    For i = 0 To .ListCount - 1
      a(j, 1) = .List(i, 0)
      a(j, 2) = .List(i, 1)
      a(j, 3) = .List(i, 3)
      a(j, 4) = .List(i, 4)
      a(j, 5) = .List(i, 16)
      a(j, 6) = .List(i, 5)
      a(j, 7) = .List(i, 7)
      a(j, 8) = .List(i, 8)
      a(j, 9) = .List(i, 9)
      a(j, 10) = .List(i, 11)
      a(j, 11) = .List(i, 12)
      a(j, 12) = .List(i, 13)
      j = j + 1
    Next
  End With
 
  sh.Range("A7").Resize(UBound(a, 1), UBound(a, 2)).Value = a

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------
Click to expand...
Thank you I always raise your hat of respect The first symbol is originally yours and it works very well What I want is to always leave a blank row between rows over an Excel sheet Example attached image or code that will replace you after copying finishes
 
Upvote 0
I'm sorry about that, it's my fault.

This is the updated code:

Rich (BB code): 
  Dim j As Long
  j = 1
  With ListBox5
    ReDim a(1 To .ListCount * 2, 1 To 12)
    For i = 0 To .ListCount - 1
      a(j, 1) = .List(i, 0)
      a(j, 2) = .List(i, 1)
      a(j, 3) = .List(i, 3)
      a(j, 4) = .List(i, 4)
      a(j, 5) = .List(i, 16)
      a(j, 6) = .List(i, 5)
      a(j, 7) = .List(i, 7)
      a(j, 8) = .List(i, 8)
      a(j, 9) = .List(i, 9)
      a(j, 10) = .List(i, 11)
      a(j, 11) = .List(i, 12)
      a(j, 12) = .List(i, 13)
      j = j + 2
    Next
  End With
  
  sh.Range("A7").Resize(UBound(a, 1), UBound(a, 2)).Value = a

sofas said:
I always raise your hat of respect
Click to expand...
Thanks for the compliment :)
 
Upvote 0
Solution
DanteAmor said:
I'm sorry about that, it's my fault.

This is the updated code:

Rich (BB code): 
  Dim j As Long
  j = 1
  With ListBox5
    ReDim a(1 To .ListCount * 2, 1 To 12)
    For i = 0 To .ListCount - 1
      a(j, 1) = .List(i, 0)
      a(j, 2) = .List(i, 1)
      a(j, 3) = .List(i, 3)
      a(j, 4) = .List(i, 4)
      a(j, 5) = .List(i, 16)
      a(j, 6) = .List(i, 5)
      a(j, 7) = .List(i, 7)
      a(j, 8) = .List(i, 8)
      a(j, 9) = .List(i, 9)
      a(j, 10) = .List(i, 11)
      a(j, 11) = .List(i, 12)
      a(j, 12) = .List(i, 13)
      j = j + 2
    Next
  End With
 
  sh.Range("A7").Resize(UBound(a, 1), UBound(a, 2)).Value = a


Thanks for the compliment :)
Click to expand...
Great but I miss something when re-copying other data the old ones are supposed to be kept and copied below them while always leaving a blank row
 
Upvote 0
sofas said:
Great but I miss something when re-copying other data the old ones are supposed to be kept and copied below them while always leaving a blank row
Click to expand...


I don't know what I did, but he worked with me. Thank you

VBA Code: 
 Set F2 = Sheets(Name_SH.Value)
 
    lastrow = F2.[A1048500].End(xlUp).Row + 1
  
  
  F2.Activate
    Dim j As Long
  j = 1
  With ListBox1
    ReDim A(1 To .ListCount * 2, 1 To 12)
    For i = 0 To .ListCount - 1
      A(j, 1) = .List(i, 0)
      A(j, 2) = .List(i, 1)
      A(j, 3) = .List(i, 3)
      A(j, 4) = .List(i, 4)
      A(j, 5) = .List(i, 16)
      A(j, 6) = .List(i, 5)
      A(j, 7) = .List(i, 7)
      A(j, 8) = .List(i, 8)
      A(j, 9) = .List(i, 9)
      A(j, 10) = .List(i, 11)
      A(j, 11) = .List(i, 12)
      A(j, 12) = .List(i, 13)
      j = j + 2
    Next
  End With
 
 
   F2.Cells(lastrow, 1).Resize(UBound(A, 1), UBound(A, 2)).Value = A
Code:
 
Upvote 1
Hello. DanteAmor.Sorry for the inconvenience again I just wanted to ask about the possibility of copying certain columns, such as the first, second and fifth columns are repeated in the empty row.
 
Upvote 0
sofas said:
copying certain columns, such as the first, second and fifth columns are repeated in the empty row.
Click to expand...

Try the following. Check out how I'm repeating certain columns in the next row. If you need another column apply my examples.

VBA Code: 
  Dim j As Long
  j = 1
  With ListBox5
    ReDim a(1 To .ListCount * 2, 1 To 12)
    For i = 0 To .ListCount - 1
      a(j, 1) = .List(i, 0)
      a(j + 1, 1) = .List(i, 0)
      
      a(j, 2) = .List(i, 1)
      a(j + 1, 2) = .List(i, 1)
      
      a(j, 3) = .List(i, 3)
      a(j, 4) = .List(i, 4)
      
      a(j, 5) = .List(i, 16)
      a(j + 1, 5) = .List(i, 16)
      
      a(j, 6) = .List(i, 5)
      a(j, 7) = .List(i, 7)
      a(j, 8) = .List(i, 8)
      a(j, 9) = .List(i, 9)
      a(j, 10) = .List(i, 11)
      a(j, 11) = .List(i, 12)
      a(j, 12) = .List(i, 13)
      j = j + 2
    Next
  End With
  
  sh.Range("A7").Resize(UBound(a, 1), UBound(a, 2)).Value = a
 
Upvote 0
DanteAmor said:
Try the following. Check out how I'm repeating certain columns in the next row. If you need another column apply my examples.

VBA Code: 
  Dim j As Long
  j = 1
  With ListBox5
    ReDim a(1 To .ListCount * 2, 1 To 12)
    For i = 0 To .ListCount - 1
      a(j, 1) = .List(i, 0)
      a(j + 1, 1) = .List(i, 0)
     
      a(j, 2) = .List(i, 1)
      a(j + 1, 2) = .List(i, 1)
     
      a(j, 3) = .List(i, 3)
      a(j, 4) = .List(i, 4)
     
      a(j, 5) = .List(i, 16)
      a(j + 1, 5) = .List(i, 16)
     
      a(j, 6) = .List(i, 5)
      a(j, 7) = .List(i, 7)
      a(j, 8) = .List(i, 8)
      a(j, 9) = .List(i, 9)
      a(j, 10) = .List(i, 11)
      a(j, 11) = .List(i, 12)
      a(j, 12) = .List(i, 13)
      j = j + 2
    Next
  End With
 
  sh.Range("A7").Resize(UBound(a, 1), UBound(a, 2)).Value = a
Click to expand...
Very enormous. You always amaze me with your suggestions thank you very much
 
Upvote 0
DanteAmor said:
I'm sorry about that, it's my fault.

This is the updated code:

Rich (BB code): 
  Dim j As Long
  j = 1
  With ListBox5
    ReDim a(1 To .ListCount * 2, 1 To 12)
    For i = 0 To .ListCount - 1
      a(j, 1) = .List(i, 0)
      a(j, 2) = .List(i, 1)
      a(j, 3) = .List(i, 3)
      a(j, 4) = .List(i, 4)
      a(j, 5) = .List(i, 16)
      a(j, 6) = .List(i, 5)
      a(j, 7) = .List(i, 7)
      a(j, 8) = .List(i, 8)
      a(j, 9) = .List(i, 9)
      a(j, 10) = .List(i, 11)
      a(j, 11) = .List(i, 12)
      a(j, 12) = .List(i, 13)
      j = j + 2
    Next
  End With
 
  sh.Range("A7").Resize(UBound(a, 1), UBound(a, 2)).Value = a


Thanks for the compliment :)
Click to expand...
Hello. Is it possible to implement the same command to copy data from one sheet to another with making a blank row between all the copied rows?
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
320
pure vito
P
M
  • Solved
Display textbox from listbox - getting 381 error
Replies
4
Views
206
maiatanaka
M
S
  • Solved
Show the largest date and the smallest date on the listbox Userform
Replies
5
Views
133
Domenic
D
I
  • Question
Listbox multiple column advice
2
Replies
10
Views
315
ipbr21054
I
A
  • Solved
Listbox For Loop
Replies
7
Views
374
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,214,829
Messages
6,121,826
Members
449,051
Latest member
excelquestion515

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top