VBA help with Paste special when combining workbooks

Jeffman52

New Member
Joined
May 14, 2021
Messages
12
Office Version
  1. 2010
Platform
  1. Windows
HI, I did look through threads to see if I could find this but I cant find something similar enough.

I grabbed this VBA from the web (don't remember the author or I would give them credit) and edited a bit.

I open a new excel sheet and add this VBA code. When I run it, I am prompted for a folder with excel documents and then it combines all the workbooks in that folder with worksheets named "Mi24", into one workbook. It seems to work well except I need it to paste special as right now its pasting the formulas that reference the original worksheets.

I have copied a picture but also the issue seems to be in this area of the macro. Any help you can provide would be great

ActiveSheet.Name = "Mi24"
For x = 1 To 1
LastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With wsDest
ActiveSheet.UsedRange.Copy .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)

.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(LastRow) = wkbSource.Name

End With

Next x
MyFile = Dir
wkbSource.Close False
Loop
 

Attachments

  • VBA.jpg
    VBA.jpg
    100 KB · Views: 1

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Just in case you need all the macro to test. See below



VBA Code:
Sub CopySheetData()
    Application.ScreenUpdating = False
    Dim MyFolder As String, MyFile As String, wkbSource As Workbook, wsDest As Worksheet, x As Long, LastRow As Long
    Set wsDest = ThisWorkbook.Sheets("Sheet1")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then
            MsgBox "You did not select a folder."
            Exit Sub
        End If
        MyFolder = .SelectedItems(1) & "\"
    End With
    MyFile = Dir(MyFolder)
    Do While MyFile <> ""
        Set wkbSource = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
       
           
    ActiveSheet.Name = "Mi24"
        For x = 1 To 1
     
            LastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
           
            With wsDest
           
                ActiveSheet.UsedRange.Copy .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
             
               
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(LastRow) = wkbSource.Name
               
            End With
           
        Next x
        MyFile = Dir
        wkbSource.Close False
    Loop
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi & welcome to MrExcel.
How about
VBA Code:
With wsDest
   ActiveSheet.UsedRange.Copy
   .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
   .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(LastRow) = wkbSource.Name
   Application.CutCopyMode = False
End With
 
Upvote 0
Solution
Thanks Fluff!!! That was perfect!! I spent about 36 hours pouring over websites looking for something. Guess I should have stopped her first. But sometimes you learn a lot by searching and struggling. Thanks again!
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0
One other thing that I should have considered and keep in mind I am in way over my head with VBA

If the Worksheet the vba is copying to gets full before all the spreadsheets are accounted for, (the error is copy and paste area are not the same size), how do I get it to move that data to a new worksheet on the workbook I am combining into?
 
Upvote 0
As that's a different question, it needs a new thread. Thanks
 
Upvote 0

Forum statistics

Threads
1,214,827
Messages
6,121,818
Members
449,049
Latest member
cybersurfer5000

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