copy and paste macro

[Pete]

Hi (see attached file)

Need a Copy and Past macro that will do the following as shown in worksheet 2 i.e take the name Austria from column B row 2 and then the tasks in column A13:A59 (which are the same for all countries as list in row 5 columns B:AD)

and also the data that relates to Austria (see column B13:B59) and insert it into worksheet 2 as shown in the example...................

repeat steps for all countries in row 5 worksheet 1......and arrange in order A to Z

The highlighted tasks in column B worksheet 2 for each country remain the same i.e Austria = column b4:b50 and belgium is column b52:b98 as shown in the example....

[georgiboy]

Can you not just link cells or do the countries change all the time?

[rbrhodes]

hi Pete,

Here's a version. The Country names were in order so I didn't sort anything.

[VBA]
Option Explicit
Sub CopyCountry()
Dim ErrMsg As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim Destrow As Long
Dim iDestrow As Long
Dim ColCount As Long
Dim DestSht As Worksheet
Dim SourceSht As Worksheet
'Create objects
Set DestSht = Sheet2
Set SourceSht = Sheet1

'Speed
Application.ScreenUpdating = False

'Set first row of Source data
FirstRow = 13

'Get last row of Source data
LastRow = SourceSht.Range("A65536").End(xlUp).Row

'Set first Col of Source data
FirstCol = 2

'Get last Col of Source data NOTE: Row 5
LastCol = SourceSht.Range("IV5").End(xlToLeft).Column

'Initialize
Destrow = 2

'Save for loop
iDestrow = Destrow

'Set up destination sheet
With DestSht
.Range("A:A").ColumnWidth = 66.14
.Range("B:B").ColumnWidth = 15.14
End With

With SourceSht
'Do all Columns
For ColCount = FirstCol To LastCol
'Copy 'steps'
.Range("A" & FirstRow & ":A" & LastRow).Copy DestSht.Range("A" & Destrow)
'Copy Country (Row 5)
.Cells(5, ColCount).Copy DestSht.Cells(Destrow - 1, 2)
'Copy Country info
.Range(Cells(FirstRow, ColCount).Address, Cells(LastRow, ColCount).Address).Copy
'Paste values and formats
With DestSht.Cells(Destrow, 2)
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
'Increment based on size of list of 'steps' and first destination row number
Destrow = Destrow + (LastRow - FirstRow) + iDestrow
Next ColCount
End With

'Destroy objects
Set DestSht = Nothing
Set SourceSht = Nothing
'Reset
Application.ScreenUpdating = True

'Normal exit
Exit Sub

'Error exit
endo:

'Destroy objects
Set DestSht = Nothing
Set SourceSht = Nothing
'Reset
Application.ScreenUpdating = True
'Inform User
ErrMsg = MsgBox("Error " & Err.Number & ". " & Err.Description)
End Sub

[/VBA]