Autoformatting import data

[Goalexcel]

Hi Expert, thank you for your outstanding support.
I usually manually format some import workbooks data, but now have been increased to more than 12 workbooks in different format.
I new with VBA, I wonder is there a solution with VBA to formatting, The code should be apply any active sheet.
please see below link to open the workbook test.

Transfer - Dropbox

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!

www.dropbox.com

 

[Goalexcel]

Hi Expert, thank you for your outstanding support.
I usually manually format some import workbooks data, but now have been increased to more than 12 workbooks in different format.
I new with VBA, I wonder is there a solution with VBA to formatting, The code should be apply any active sheet.
please see below link to open the workbook test.

Please follow this new link of the excel file Mar Pav sent you 1 item

 

[maabadi]

Are you want Exact format same as Final sheet2 & Final sheet3 ?

 

[maabadi]

I copy your format from Finalsheet2 From Column A:B for 3 first row & then Columns C:D for Last 2 rows.
You can set one Index sheet for formatting then copy format from Index sheet to Others.
Also you can see two green Line at code. these Lines can be used for selection range for copy format and select first cell for Paste format if you want.
for this purpose you should remove ' at the first of that lines.
This is Macro.

Sub CopyFormat()
Dim CopyRng As Range, PasteRng As Range, Lr1 As Long, Lr2 As Long
Lr1 = Sheets("Finalsheet2").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Range("A:K").Delete
Sheets("Sheet2").Range("1:2").Delete
Lr2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Set CopyRng = Sheets("Finalsheet2").Range("A1:B" & Lr1)
Set PasteRng = Sheets("Sheet2").Range("A1:C" & Lr2)
'Set CopyRng = Application.InputBox("Ranges to be copied :", xTitleId, CopyRng.Address, Type:=8)
'Set PasteRng = Application.InputBox("Paste to (single cell):", xTitleId, Type:=8)
CopyRng.Copy
PasteRng.PasteSpecial xlPasteFormats
Set CopyRng = Sheets("Finalsheet2").Range("C1:D" & Lr1)
Set PasteRng = Sheets("Sheet2").Range("D1:E" & Lr2)
CopyRng.Copy
PasteRng.PasteSpecial xlPasteFormats
Sheets("Sheet2").Range("A1:E" & Lr2).Sort key1:=Range("C1"), Order1:=xlAscending, key2:=Range("A1"), _
Order2:=xlAscending, Header:=xlYes
Sheets("Sheet2").Range("A1:E" & Lr2).AutoFilter
Sheets("Sheet2").Range("A1:E" & Lr2).Columns.AutoFit
Sheets("Sheet2").Range("A1:E" & Lr2).Rows.AutoFit
Application.CutCopyMode = False
End Sub

 

[Goalexcel]

Are you want Exact format same as Final sheet2 & Final sheet3 ?

Hi, Yes exact format same as Final Sheet 2 & Final sheet 3, because we need to print.

 

[maabadi]

If you want to Use InputBoxes then your Source range and Paste ranges should be have save columns. and you can use different Input Box for first rows have same structure copy 2 column and Paste columns you want same format at them (for your file 3 column) and again do this for your Last 2 column.
I upload two macro for this.
1. first without Inputbox

Sub CopyFormat()
Dim CopyRng As Range, PasteRng As Range, Lr1 As Long, Lr2 As Long
Lr1 = Sheets("Finalsheet2").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Range("A:K").Delete
Sheets("Sheet2").Range("1:2").Delete
Lr2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Set CopyRng = Sheets("Finalsheet2").Range("A1:B" & Lr1)
Set PasteRng = Sheets("Sheet2").Range("A1:C" & Lr2)
CopyRng.Copy
PasteRng.PasteSpecial xlPasteFormats
Set CopyRng = Sheets("Finalsheet2").Range("C1:D" & Lr1)
Set PasteRng = Sheets("Sheet2").Range("D1:E" & Lr2)
CopyRng.Copy
PasteRng.PasteSpecial xlPasteFormats
PasteRng.WrapText = True
Sheets("Sheet2").Range("A1:E" & Lr2).Sort key1:=Range("C1"), Order1:=xlAscending, key2:=Range("A1"), _
Order2:=xlAscending, Header:=xlYes
Sheets("Sheet2").Range("A1:E" & Lr2).AutoFilter
Sheets("Sheet2").Range("A1:E" & Lr2).Columns.AutoFit
Sheets("Sheet2").Range("A1:E" & Lr2).Rows.AutoFit
Application.CutCopyMode = False
End Sub

With InputBox

Sub CopyFormat()
Dim CopyRng As Range, PasteRng As Range, Lr1 As Long, Lr2 As Long
Lr1 = Sheets("Finalsheet2").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Range("A:K").Delete
Sheets("Sheet2").Range("1:2").Delete
Lr2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Set CopyRng = Application.InputBox("First Range with same Format to be copied :", xTitleId, CopyRng.Address, Type:=8)
Set PasteRng = Application.InputBox("Select all Range:", xTitleId, Type:=8)
CopyRng.Copy
PasteRng.PasteSpecial xlPasteFormats
Set CopyRng = Application.InputBox("Second Range with same Format to be copied :", xTitleId, CopyRng.Address, Type:=8)
Set PasteRng = Application.InputBox("Select all Range:", xTitleId, Type:=8)
CopyRng.Copy
PasteRng.PasteSpecial xlPasteFormats
PasteRng.WrapText = True
Sheets("Sheet2").Range("A1:E" & Lr2).Sort key1:=Range("C1"), Order1:=xlAscending, key2:=Range("A1"), _
Order2:=xlAscending, Header:=xlYes
Sheets("Sheet2").Range("A1:E" & Lr2).AutoFilter
Sheets("Sheet2").Range("A1:E" & Lr2).Columns.AutoFit
Sheets("Sheet2").Range("A1:E" & Lr2).Rows.AutoFit
Application.CutCopyMode = False
End Sub

 

[maabadi]

Use this Macro with Deleting Column M:

Then Use this Macro:
VBA Code:
Sub CopyFormat()
Dim CopyRng As Range, PasteRng As Range, Lr1 As Long, Lr2 As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook
Set Sh1 = Sheets("Finalsheet2")   'Source Sheet
Set Sh2 = Sheets("Sheet2")        'Destination Sheet
Lr1 = Sh1.Range("A" & Rows.Count).End(xlUp).Row
Sh2.Columns(13).Delete
Sh2.Range("A:K").Delete
Sh2.Range("1:2").Delete
Lr2 = Sh2.Range("A" & Rows.Count).End(xlUp).Row
Set CopyRng = Sh1.Range("A1:D" & Lr1)
Set PasteRng = Sh2.Range("A1:D" & Lr2)
CopyRng.Copy
PasteRng.PasteSpecial xlPasteFormats
PasteRng.PasteSpecial Paste:=xlPasteColumnWidths
PasteRng.Sort key1:=Range("B1"), Order1:=xlAscending, key2:=Range("A1"), _
Order2:=xlAscending, Header:=xlYes
PasteRng.AutoFilter
PasteRng.WrapText = True
PasteRng.Rows.AutoFit
Application.CutCopyMode = False
End Sub

 

[Goalexcel]

Use this Macro with Deleting Column M:

Then Use this Macro:
VBA Code:
Sub CopyFormat()
Dim CopyRng As Range, PasteRng As Range, Lr1 As Long, Lr2 As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook
Set Sh1 = Sheets("Finalsheet2")   'Source Sheet
Set Sh2 = Sheets("Sheet2")        'Destination Sheet
Lr1 = Sh1.Range("A" & Rows.Count).End(xlUp).Row
Sh2.Columns(13).Delete
Sh2.Range("A:K").Delete
Sh2.Range("1:2").Delete
Lr2 = Sh2.Range("A" & Rows.Count).End(xlUp).Row
Set CopyRng = Sh1.Range("A1:D" & Lr1)
Set PasteRng = Sh2.Range("A1:D" & Lr2)
CopyRng.Copy
PasteRng.PasteSpecial xlPasteFormats
PasteRng.PasteSpecial Paste:=xlPasteColumnWidths
PasteRng.Sort key1:=Range("B1"), Order1:=xlAscending, key2:=Range("A1"), _
Order2:=xlAscending, Header:=xlYes
PasteRng.AutoFilter
PasteRng.WrapText = True
PasteRng.Rows.AutoFit
Application.CutCopyMode = False
End Sub

Thank you a lot, Maabadi, works perfect, outstanding support.

 

[maabadi]

You're Welcome & Thanks for Feedback.