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 ?
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
if code is not reporting any errors then try it as I published it.

Dave
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,048
Members
448,543
Latest member
MartinLarkin

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