For every file in folder A, create a new one with same data, but different formating

[grozny28]

I need your help!
I’ve got many files with data in specific format. My intention is to change these workbooks formatting, without changing inserted values. What I already have is this poor code, that copies values from source workbook and puts them in a new one.

[COLOR=#000000][FONT=Arial][COLOR=#222222][FONT=Verdana]
Option Explicit
[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]Sub MojeM()[/FONT][/COLOR][/FONT][/COLOR]
Dim x As Workbook
Dim y As Workbook
 
' ~~~>  Check if the source workbook is open; if not - open it:
 
If IsWorkbookOpen("1") Then
        Set x = Workbooks("1")
    Else
        Set x = Workbooks.Open("D:\1.xlsx")
    End If
 
' ~~~> Check if the target workbook is open; if not - open it:
 
    If IsWorkbookOpen("2") Then
        Set y = Workbooks("2")
    Else
        Set y = Workbooks.Open("D:\2.xlsx")
    End If
 
' ~~~> Move values from source to target workbook:
' ~~~> I added "value2"
 
' with sheetname y.Sheets("2").Range("b9:q9").Value2 = x.Sheets("1").Range("b9:q9").Value2
 
' ~~~> WTF code
y.Sheets("2").Range("c9").Value2 = x.ActiveSheet.Range("c9").Value2
 
y.Sheets("2").Range("e9").Value2 = x.ActiveSheet.Range("d9").Value2
y.Sheets("2").Range("g9").Value2 = x.ActiveSheet.Range("f9").Value2
y.Sheets("2").Range("i9").Value2 = x.ActiveSheet.Range("h9").Value2
y.Sheets("2").Range("k9").Value2 = x.ActiveSheet.Range("j9").Value2
y.Sheets("2").Range("m9").Value2 = x.ActiveSheet.Range("m9").Value2
y.Sheets("2").Range("o9").Value2 = x.ActiveSheet.Range("o9").Value2
y.Sheets("2").Range("q9").Value2 = x.ActiveSheet.Range("r9").Value2
 
y.Sheets("2").Range("e11").Value2 = x.ActiveSheet.Range("d11").Value2
y.Sheets("2").Range("g11").Value2 = x.ActiveSheet.Range("f11").Value2
y.Sheets("2").Range("i11").Value2 = x.ActiveSheet.Range("h11").Value2
y.Sheets("2").Range("k11").Value2 = x.ActiveSheet.Range("j11").Value2
y.Sheets("2").Range("m11").Value2 = x.ActiveSheet.Range("m11").Value2
y.Sheets("2").Range("o11").Value2 = x.ActiveSheet.Range("o11").Value2
y.Sheets("2").Range("q11").Value2 = x.ActiveSheet.Range("r11").Value2
 
y.Sheets("2").Range("e15:j40").Value2 = x.ActiveSheet.Range("f15:k40").Value2
' ~~~ (optional) I could skip grey rows (1-6). (y.Sheets("2").Range("e16").Value = x.Sheets("1").Range("e16"))
 
' ~~~> (optional) close source workbook:
'x.Close
 
End Sub
 
Function IsWorkbookOpen(stName As String) As Boolean
    Dim Wkb As Workbook
    On Error Resume Next
    Set Wkb = Workbooks(stName)
    If Not Wkb Is Nothing Then IsWorkbookOpen = True
End Function

For now, I have no idea, how to make this happen:
~ For every (source) file in folder A, create a new file (with the same filename; based on template in “2.docx”) in folder B and apply code above. ~
Source file: https://mega.co.nz/#!KJAy2DyD!jVVvtIfqx34Ky5E0_szXJFxchrzc8605-SgyYQ3CAWg
Target file: https://mega.co.nz/#!SNxk2ATQ!YNiAp1GprOBI6APicpm-lmXebyFL1T5qoLqxY62Kk9U