Please help with code

lakke2120

New Member
Joined
Aug 21, 2014
Messages
31
Hello,
I am new to coding and I am having a problem with this code. I would like it to copy and paste special values and not formulas. Everything else is working fine.
thank you

Sub CombineData()
Dim myDir As String, filename As String
Dim lrdata As Long
Dim masterws As Worksheet

Application.ScreenUpdating = False
Set masterws = ThisWorkbook.Sheets("Data")
myDir = "E:\test folder" '<- Change here (Folder path)
filename = Dir(myDir & "\Payroll*.xls*")
Do While filename <> ""
With Workbooks.Open(myDir & "\" & filename)
With .Sheets("totals")
lrdata = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:T625" & lrdata).Copy _
Destination:=masterws.Range("A" & masterws.Rows.Count).End(xlUp).Offset(1)
End With
.Close False
End With
filename = Dir
Loop
Set masterws = Nothing
Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

iliace

Well-known Member
Joined
Jan 15, 2008
Messages
3,543
Office Version
  1. 365
  2. 2016
  3. 2010
Platform
  1. Windows
You have to split it up into two separate operations.

Code:
      .Range("A1:T625" & lrdata).Copy
      masterws.Range("A" & masterws.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

Post back if this is not clear.
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,504
Office Version
  1. 2013
Platform
  1. Windows
Try
Rich (BB code):
With Sheets("totals")
lrdata = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:T625" & lrdata).Copy
masterws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
 

lakke2120

New Member
Joined
Aug 21, 2014
Messages
31
Thank you SO MUCH for answering so quick. That was really cool. I am getting a "loop without do" error and not sure how to fix it.
thanks again
 

Teeroy

Well-known Member
Joined
Nov 9, 2012
Messages
2,240

ADVERTISEMENT

Re-post the code as you have changed it.
 

lakke2120

New Member
Joined
Aug 21, 2014
Messages
31
Here is is:
Sub CombineData()
Dim myDir As String, filename As String
Dim lrdata As Long
Dim masterws As Worksheet

Application.ScreenUpdating = False
Set masterws = ThisWorkbook.Sheets("Data")
myDir = "E:\test folder2" '<- Change here (Folder path)
filename = Dir(myDir & "\Payroll*.xls*")
Do While filename <> ""
With Workbooks.Open(myDir & "\" & filename)
With Sheets("totals")
lrdata = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:T625" & lrdata).Copy
masterws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
filename = Dir
Loop
Set masterws = Nothing
Application.ScreenUpdating = True

End Sub
 

iliace

Well-known Member
Joined
Jan 15, 2008
Messages
3,543
Office Version
  1. 365
  2. 2016
  3. 2010
Platform
  1. Windows

ADVERTISEMENT

The error message is pretty accurate - you're missing an End to a With:)

Rich (BB code):
Do While filename <> ""
  With Workbooks.Open(myDir & "\" & filename)
    With Sheets("totals")
      lrdata = .Range("A" & .Rows.Count).End(xlUp).Row
      .Range("A1:T625" & lrdata).Copy
      masterws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    End With
    filename = Dir
  End With
Loop
 

Teeroy

Well-known Member
Joined
Nov 9, 2012
Messages
2,240
The error message is pretty accurate - you're missing an End to a With:)

Rich (BB code):
Do While filename <> ""
  With Workbooks.Open(myDir & "\" & filename)
    With Sheets("totals")
      lrdata = .Range("A" & .Rows.Count).End(xlUp).Row
      .Range("A1:T625" & lrdata).Copy
      masterws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    End With
    filename = Dir
  End With
Loop

When I get a Next without For error I also look for a missing End If. Isn't excel helpful :).
 

Watch MrExcel Video

Forum statistics

Threads
1,119,055
Messages
5,575,840
Members
412,689
Latest member
amazonsellerassociation
Top