copy a range from one workbook to another

[luvbite38]

Hi guys,

I have two workbooks

1- FromCopy
2-ToCopy

They both have over 600 worksheets and both are identical in both books. I am tryin to run a macro which should copy a range (A2:A9) from each sheet of FromCopy and paste it in sheet with the similar name into ToCopy
Also, I want to run this macro on all the sheets except two (Intro and Lukups)

example

Select workbook FromCopy Select Sheet Called A Copy range A2:A9
Select workbook ToCopy Select Sheet called with same name i.e. A and paste the range into A2:A9
and repeat this procedure to all the sheets except two sheets (Intro and Lukups)

I hope it makes sense?

 

[luvbite38]

Thanks a million in advance for helping out guys

 

[shadow12345]

Something like this? (not the cleanest but best i can do im afraid)

Sub OpenEx()
    Dim sPath As String
    Dim copyto As Workbook
    Dim from As Workbook
    Dim ws As Worksheet
     
    sPath = "F:\Desktop\Copy From.xlsx"  'change the path to suit
    Set copyto = ThisWorkbook
    Set from = Workbooks.Open(sPath)
    Application.ScreenUpdating = False
     
    For Each ws In from.Worksheets
        
        ws.Select
        wsname = ws.Name
        If ws.Name <> "Intro" Then
        If ws.Name <> "Lukups" Then
        
        Range("A2:A9").Copy
        Windows("copy to").Activate
        Sheets(wsname).Select
        Range("A2").Select
        ActiveSheet.Paste
        Windows("Copy from").Activate
        
        End If
        End If
    Next
 Application.ScreenUpdating = True
End Sub

 

[luvbite38]

Something like this? (not the cleanest but best i can do im afraid)

Sub OpenEx()
    Dim sPath As String
    Dim copyto As Workbook
    Dim from As Workbook
    Dim ws As Worksheet
     
    sPath = "F:\Desktop\Copy From.xlsx"  'change the path to suit
    Set copyto = ThisWorkbook
    Set from = Workbooks.Open(sPath)
    Application.ScreenUpdating = False
     
    For Each ws In from.Worksheets
        
        ws.Select
        wsname = ws.Name
        If ws.Name <> "Intro" Then
        If ws.Name <> "Lukups" Then
        
        Range("A2:A9").Copy
        Windows("copy to").Activate
        Sheets(wsname).Select
        Range("A2").Select
        ActiveSheet.Paste
        Windows("Copy from").Activate
        
        End If
        End If
    Next
 Application.ScreenUpdating = True
End Sub

Hey mate,

you're a gem

I had to make some minor adjustment but this worked like a charm.......

YOU'RE A SUPERSTAR

Regards,

LB