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

[faithtirta]

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

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

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

 

[OaklandJim]

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.

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