Copying selected rows ad keeping all formatting

[DaveUK]

I have a workbook "Book1" which opens a second workbook with this code:

option explicit

Global MainWorkBook As Workbook
Global DailySchedules As Workbook

Sub OpenDailyScheduleWorkbook()

Dim Filename As String
Dim response As String

Set MainWorkBook = ActiveWorkbook

Application.StatusBar = "IMPORTING WORKBOOK DATA ...PLEASE WAIT..."

    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    End With


    Filename = Application.GetOpenFilename(FileFilter:="Excel Files,*.xls", Title:="Please choose Workbook to open")
    If Not Chk(Filename) Then
    'If Filename = "False" Then
    response = MsgBox("No file selected" & Chr(10) & "procedure cancelled!", 48, "Error")
    Exit Sub
  
  Else: Set DailySchedules = Workbooks.Open(Filename)
  End If
  
  Application.DisplayAlerts = False
  
     
 ' CODE NEEDED HERE !!


 DailySchedules.Close False
 
    
       
   Application.StatusBar = "Ready"

    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    End With
    
End Sub

Function Chk(myFile As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Chk = fso.FileExists(myFile)
Set fso = Nothing
End Function

What i need to do is copy all rows from a worksheet on "DailySchedules" called "Works". I need to copy all rows that contain tomorrows date in column F of this worksheet (formatted as "d-mmm-yyyy").
I need to copy all these cells to a worksheet on "MainWorkBook" called "Sheet1", starting at cell "A1". I also want to keep all formatting of everything copied.

The data on worksheet "Works" in workbook "DailySchedules" starts at row 4 (as there is a header on the first 3 rows) and can be an unknown nuber of rows down.

I have indicated in the code above where i need the code to be inserted but do not know how to do what is required.

TIA

 

[Tazguy37]

How about something like this?:

Dim cell As Range

    For Each cell In Workbooks("DailySchedules.xls").Worksheets("Works").Range("F:F").SpecialCells(xlCellTypeConstants, xlNumbers)
        If cell.Value = Date + 1 Then
            cell.EntireRow.Copy
            Workbooks("MainWorkbook.xls").Worksheets("Sheet1").Range("F" & Rows.Count).End(xlUp).Offset(1, -5).PasteSpecial
        End If
    Next cell
    Workbooks("MainWorkbook.xls").Worksheets("Sheet1").Range("A1").EntireRow.Delete xlUp
    Application.CutCopyMode = False

Try it out on a copy and see if that does what you want. HTH

 

[DaveUK]

Thanks for replying.

I am getting a type mismatch error.

The workbooks are not called ("MainWorkbook.xls") or ("DailySchedules.xls"). They are referred to by the names "DailySchedules" and "MainWorkbook" using the SET command.

eg .

Set MainWorkBook = ActiveWorkbook 

'...

Set DailySchedules = Workbooks.Open(Filename)

How do i work around this problem??

TIA

 

[Tazguy37]

Use:

Workbooks(DailySchedules.Name)

instead of

Workbooks("DailySchedules.xls")

Hope that helps!

Edit: Typo

 

[DaveUK]

Fantastic !! Worked a treat.

Many, many thanks