Macro that copies and pastes from each file into formatted master sheet with merged cells

faithtirta

New Member
Joined
May 1, 2023
Messages
7
Office Version
  1. 365
Platform
  1. Windows
I need help creating a macro that goes through each file in a folder and copies distinct cells in each file (all the files have the same formatting). Then I need to paste each cell into a master sheet that contains merged cells that are different sizes (as shown in the picture attached). With the code I have right now, an error pops up saying that the code can't be done because the master sheet contains merged cells that need to be the same size but the formatting on the master sheet has to be this way. If anyone knows away around this error any help would be much appreciated.
Cells copied from each file in the folder needs to pasted on a new formatted row. I had tried the VBA code for pasting to the next available row but that doesn't work due to the master sheet format and ends up pasting at the end of the master sheet where the formatting ends. The code I have now pastes every 6th row because of the formatting each formatted row in the master sheet contains (6 excel rows).

Essentially this is what I need my macro to do:

Go through files in a folder and copy these cells from each file (these cells will be consistent)
G13 -- > pasted to master sheet to E10-15
E21 ---> C10-15
C95 ---> D10-15
C101 ----> I10-15
E101 ---> K10-15
G101 --->M10-15

then for the next file it needs to be pasted to and so on
G13 -- > E16-21
E21 ---> C16-21
C95 ---> D16-21
C101 ----> I16-21
E101 ---> K16-21
G101 --->M16-21

1682976493020.png



VBA Code:
Private Sub TestMacro()

   Dim strPath As String
   Dim strFile As String
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim wsTarget As Worksheet
   Dim rowOutputTarget As Long
 
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
 
   strPath = "my folder path"
   If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
 
   'set the target worksheet
   Set wsTarget = ActiveWorkbook.Worksheets("Sheet 1")
 
   'set the initial output row
   rowOutputTarget = 10
 
   'get the first file
   strFile = Dir(strPath & "*.xlsb*")
 
   'loop throught the excel files in the folder
   Do While strFile <> ""

         'open the workbook
         Set wbSource = Workbooks.Open(strPath & strFile)
         Set wsSource = wbSource.Worksheets("Sheet 1")
       
         'copy and paste
         wsSource.Range("G13").Copy
         wsTarget.Range("E" & rowOutputTarget).PasteSpecial Paste:=xlPasteValues
       
         wsSource.Range("E21").Copy
         wsTarget.Range("C" & rowOutputTarget).PasteSpecial Paste:=xlPasteValues
       
         wsSource.Range("C95").Copy
         wsTarget.Range("D" & rowOutputTarget).PasteSpecial Paste:=xlPasteValues
       
         wsSource.Range("C101").Copy
         wsTarget.Range("I" & rowOutputTarget).PasteSpecial Paste:=xlPasteValues
       
         wsSource.Range("E101").Copy
         wsTarget.Range("K" & rowOutputTarget).PasteSpecial Paste:=xlPasteValues
       
         wsSource.Range("G101").Copy
         wsTarget.Range("M" & rowOutputTarget).PasteSpecial Paste:=xlPasteValues
       
         'update output row
         rowOutputTarget = rowOutputTarget + 6
       
         wbSource.Close SaveChanges:=False

      'get the next file
      strFile = Dir()
   Loop
 
   MsgBox ("Done")
 
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

1682976214784.png

This is the error I am receiving for my current code. If you need any clarifiactions please reach out any help is much appreicated! Thank you :)
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
GENERALLY Excel folks recommend that you avoid the use of merged cells as they cause more trouble than they are worth. Would "Center Across Selection" formatting do what is needed instead?

Also, ideally you post your workbook so someone willing to assist does not have to try to create a workbook with fake data. Use the link icon above the message area.

Also there is no need to copy and paste range content like your code does.

VBA Code:
         wsTarget.Range("M" & rowOutputTarget).Value = wsSource.Range("G101").Value
 

Attachments

  • CenterAcrossSelection.jpg
    CenterAcrossSelection.jpg
    45 KB · Views: 10
Upvote 0

Forum statistics

Threads
1,224,462
Messages
6,178,815
Members
452,881
Latest member
motivationgyan

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