find value and copy column to new spreadsheet

[stelllar_1]

Hi,
can someone please help me with this one?
I have one workbook where I have columns a-c containing common
information (a: app name, b: description, c: date),
then the rest of the columns contain translated info for several
languages. For instance it would be DGerman App name), E: (German
description), FFrench App name), GFrench description) etc.
What I would like to do is to create a new workbook for each language,
ie. GERname.xls, FREname.xls etc. where columns a, b & c are copied
there, and where the heading contains the word German, the whole column
is moved into the GERname.xls next to column a,b & c.

So all sheets will have the same info in a, b and c, but column d & e
are "localized" for each file.

I know how to do parts of it but put it all together is way over my
skill for the time being

 

[Dave Peterson]

So if you were doing it manually, you could copy the original worksheet to a new
workbook.

Then delete columns F:IV (to keep A:C and D:E)

Then copy the original again, but this time delete D:E, H:IV

When you're done, you're always left with 5 columns???

Option Explicit
Sub testme()

Dim iCol As Long
Dim LastCol As Long
Dim curWks As Worksheet
Dim newWks As Worksheet

Set curWks = Worksheets("sheet1")
With curWks
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

If (LastCol Mod 2) <> 1 Then
MsgBox "design error there should be an odd number of columns!"
Exit Sub
End If

For iCol = 4 To LastCol Step 2
curWks.Copy 'to a new workbook
Set newWks = ActiveSheet

With newWks
'delete columns on the far right
.Range(.Cells(1, iCol + 2), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
'delete the middle columns
If iCol > 5 Then
.Range("d1", .Cells(1, iCol - 1)).EntireColumn.Delete
End If
End With
Next iCol

End Sub