Copy nhanh định dạng từ 1 files cho nhiều files. (1 người xem)

[caocat]

Em chào cả nhà.
Cả nhà cho em hỏi. Em có 1 files mẫu (1.xlsx) đã tô màu các ngày(nguyên dòng). Giờ muốn 2 fles (2.xlsx, 3.xlsx) cũng được tô màu các ngày giống như files 1. Thì mình làm cách nào cho nhanh, áp dụng 1 lúc cho nhiều files (100 files). Thay vì phải mở từng files sử dụng Format Painter.
Em cảm ơn.

 

[giaiphap]

Em chào cả nhà.
Cả nhà cho em hỏi. Em có 1 files mẫu (1.xlsx) đã tô màu các ngày(nguyên dòng). Giờ muốn 2 fles (2.xlsx, 3.xlsx) cũng được tô màu các ngày giống như files 1. Thì mình làm cách nào cho nhanh, áp dụng 1 lúc cho nhiều files (100 files). Thay vì phải mở từng files sử dụng Format Painter.
Em cảm ơn.

Dùng thử code này xem sao.

Sub GPE()
Dim i As Integer, Rng As Range, Wb As Workbook, Rng2 As Range
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*"
        Set Rng = Sheet1.Range("A3:Z61")
        Rng.Copy
        If .Show = True Then
            For i = 1 To .SelectedItems.Count
                Set Wb = Workbooks.Open(.SelectedItems(i))
                Set Rng2 = Wb.Sheets(1).UsedRange
                Rng2.Offset(2).Resize(Rng2.Rows.Count - 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Wb.Close True
            Next i
        End If
        Application.CutCopyMode = False
    End With
    MsgBox "Da thuc hien xong!"
End Sub

 

[caocat]

Dùng thử code này xem sao.

Sub GPE()
Dim i As Integer, Rng As Range, Wb As Workbook, Rng2 As Range
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*"
        Set Rng = Sheet1.Range("A3:Z61")
        Rng.Copy
        If .Show = True Then
            For i = 1 To .SelectedItems.Count
                Set Wb = Workbooks.Open(.SelectedItems(i))
                Set Rng2 = Wb.Sheets(1).UsedRange
                Rng2.Offset(2).Resize(Rng2.Rows.Count - 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Wb.Close True
            Next i
        End If
        Application.CutCopyMode = False
    End With
    MsgBox "Da thuc hien xong!"
End Sub

Em cảm ơn. Để em thử.