Need help with a Macro in Excel, Copy and past from another wb in the nest line

chrisay12

New Member
Joined
May 27, 2018
Messages
4
Dear Reader,
I need help with this Macro:


Dim strF As String, strP As String
Dim wb As Workbook
Dim ws As Worksheet

strP = "C:\Users\USER\Desktop\test" 'change for the path of your folder
strF = Dir(strP & "\*.xls") 'Change as required

Do While strF <> vbNullString

Set wb = Workbooks.Open(strP & "" & strF)
Set ws = wb.Sheets(1) 'I define ws to take the first sheet from each workbook
ws.Range("B6:P6").Copy Workbooks("Book1").Sheets(1).Range("B18") 'Book1 where they should be pasted.


wb.Close True

strF = Dir()
Loop



The need of this macro is to copy a line (B6:P6) from 90 excel workbooks (Files) and paste it into a new Workbook in the first sheet.
My problem is that I cant make it paste the lines in row (down to each other), for example first line should be pasted in B18 the next one in B19 and so on ...

Can you help me please ?
 

Some videos you may like

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,103
Office Version
  1. 2019
Platform
  1. Windows
Hi welcome to forum

see if this update to your code does what you want

Code:
 Dim strF As String, strP As String
    Dim NextRow As Long
    Dim wb As Workbook
    Dim ws As Worksheet
    
'change for the path of your folder
    strP = "C:\Users\USER\Desktop\test"
    
'Change as required
    strF = Dir(strP & "\*.xls")
    
'define ws to paste copied records to
    Set ws = ThisWorkbook.Worksheets(1)
    
    Do While strF <> vbNullString
'turn screen updating off
        Application.ScreenUpdating = False
'open read only
        Set wb = Workbooks.Open(strP & "" & strF, False, True)
'next row to paste to
        NextRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1
'ensure start at row 18
        If NextRow < 18 Then NextRow = 18
'copy range & paste to nextrow in worksheet.
        wb.Sheets(1).Range("B6:P6").Copy ws.Cells(NextRow, 2)
'close without saving
        wb.Close False
        
        strF = Dir()
'release object variable from memory
        Set wb = Nothing
    Loop
    
    Application.ScreenUpdating = True

Dave
 

chrisay12

New Member
Joined
May 27, 2018
Messages
4
Hi Dave,

Thanks for a quick reply.
It didnt work.

I managed to make it like that:
Dim strF As String, strP As String
Dim wb As Workbook
Dim ws As Worksheet

strP = "C:\Users\USER\Desktop\test" 'change for the path of your folder
strF = Dir(strP & "\*.xls") 'Change as required

Do While strF <> vbNullString

Set wb = Workbooks.Open(strP & "" & strF)
Set ws = wb.Sheets(1) 'I define ws to take the first sheet from each workbook
ws.Range("B6:P6").Copy Workbooks("Book1").Sheets(1).Range("B18")<code>.End(xlUp).Offset(1, 0)</code>


wb.Close True

strF = Dir()
Loop




If you take a look on the ws.range("B6:P6").....End(Xlup).offset(1, 0)
it paste it exactly how I want always in the next line, but it doesn't starts in B18, it starts at B1.
Is there anything that I can add to make it start at B18 ?


Christian
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,103
Office Version
  1. 2019
Platform
  1. Windows
did you use the updated code as published or have you made some changes to it?

To start at particular line setting a row variable (NextRow) is in my updated code is one method to do what you want.

Dave
 

chrisay12

New Member
Joined
May 27, 2018
Messages
4

ADVERTISEMENT

I updated few things in your code:
Dim strF As String, strP As String
Dim NextRow As Long
Dim wb As Workbook
Dim ws As Worksheet

'change for the path of your folder
strP = "C:\Users\USER\Desktop\test"

'Change as required
strF = Dir(strP & "\*.xls")

'define ws to paste copied records to
Set ws = Workbooks("Book1").Sheets(1)

Do While strF <> vbNullString
'turn screen updating off
Application.ScreenUpdating = False
'open read only
Set wb = Workbooks.Open(strP & "" & strF, False, True)
'next row to paste to
NextRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1
'ensure start at row 18
If NextRow < 18 Then NextRow = 18
'copy range & paste to nextrow in worksheet.
wb.Sheets(1).Range("B6:P6").Copy ws.Cells(NextRow, 2)
'close without saving
wb.Close False

strF = Dir()
'release object variable from memory
Set wb = Nothing
Loop

Application.ScreenUpdating = True



Im not sure what I'm doing wrong that it doesn't want to work.
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,103
Office Version
  1. 2019
Platform
  1. Windows
if code is not reporting any errors then try it as I published it.

Dave
 

chrisay12

New Member
Joined
May 27, 2018
Messages
4
Hi Dave,

I tried it, it doesn't paste it. I will work on your code tomorrow and will let you know :D

Thanks a lot for the help

BR
Christian
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,103
Office Version
  1. 2019
Platform
  1. Windows
Hi Dave,

I tried it, it doesn't paste it. I will work on your code tomorrow and will let you know :D

Thanks a lot for the help

BR
Christian

Just created a test file & code ran ok for me. Are your sure filepath specified is correct?


Dave
 

Watch MrExcel Video

Forum statistics

Threads
1,109,451
Messages
5,528,827
Members
409,839
Latest member
akashsadhu
Top