Dynamic "Copy And Paste"

[soidog]

Hi all,
I’m new to VBA and need some help with copying dynamic ranges from Sheet2 to Sheet1.

In Sheet2, I have 5 dynamic ranges. Named in col."A" as: Dep-1, Dep-2, Dep-3, Dep-4, Dep-5
Each range have data in column A,B,C,D,E and I.
Below range name (e.g Dep-1) are some rows with info. Then follows the header "Name".
Each dynamic range in col."A" have the same header "Name", but ends with different text in the last cell of the range. The first five characters in the "end cells" in col."A", are the same in all five ranges.
"End cells" in the other five colomns, are first blank cell below "Header2, Header3, etc. etc.
Let's say A1="Dep-1", A5="Name" and A10=Endin* (star in A10 means any characters)
What I want to do is to copy from first cell below "Name" (can't use A6 because ranges are dynamic) to first cell above "Endin*" (can't use A9 because ranges are dynamic) in all five dynamic ranges and then paste it in Sheet1.
Because each column in Sheet2 goes to different columns in Sheet1 you can't copy (e.g A6:I9) and paste the whole range.
Copy Sheet2 col."A" to Sheet1 col."A"
Copy Sheet2 col."B" to Sheet1 col."C"
Copy Sheet2 col."C" to Sheet1 col."F"
Copy Sheet2 col."D" to Sheet1 col."G"
Copy Sheet2 col."E" to Sheet1 col."I"
Copy Sheet2 col."I" to Sheet1 col."R"

I don't know which is best: Do the columns first, range by range or do the ranges first, column by column.

First range (Sheet2 Dep-1) columns (A;B;C;D;E;I) shall be pasted in Sheet1, (Row42) A42, C42, F42, G42, I42, R42
Second range (Sheet2 Dep-2) columns (A;B;C;D;E;I) shall be pasted in Sheet1 (Row62) A62, C62, F62, G62, I62, R62
Third range:Row 82
Fourth range:Row 102
Fifth range:Row 122

Below is code that works for the first three (of 6) columns, for the first dynamic range (Dep-1). My problem is how to do the same for the other 4 dynamic ranges.

Sub FrSheet2to1()
 
Dim foundA As Range, _
       foundB As Range
Dim newSht As Worksheet
   
Application.ScreenUpdating = False
On Error GoTo Terminate
 
    With Sheets("Sheet2").Columns(1)
        Set foundA = .Find("Name") 'Or should it find "Dep-1" first, to be more precise?
        Set foundB = .Find("Endin*", after:=foundA, searchdirection:=xlNext)
    End With
        Range(foundA(2), foundB(0)).Copy
        Set newSht = Sheets("Sheet1")
        newSht.Range("A42").PasteSpecial
   
    With Sheets("Sheet2").Columns(2)
        Set foundA = .Find("Header2")
        Set foundB = .Find("", after:=foundA, searchdirection:=xlNext)
    End With
        Range(foundA(2), foundB(0)).Copy
        Set newSht = Sheets("Sheet1")
        newSht.Range("C42").PasteSpecial
 
    With Sheets("Sheet2").Columns(3)
        Set foundA = .Find("Header3")
        Set foundB = .Find("", after:=foundA, searchdirection:=xlNext)
    End With
        Range(foundA(2), foundB(0)).Copy
        Set newSht = Sheets("Sheet1")
        newSht.Range("F42").PasteSpecial
 
Exit Sub
Terminate:
MsgBox "Your code is sooo WRONG!!!"
End
 
Application.ScreenUpdating = True
End Sub

I hope all this text makes sense. If not please ask for clarification.
Any help will be greatly appreciated.
Thanks!

 

[soidog]

Anyone?