sooty8
12-13-2007, 05:26 AM
Hi All
Scratching my head with this one -- I receive several Emails every week in CSV format for example 5042,WM10562,507,1107 - I copy and paste into Excel ColA do Text to Columns no problem then run a macro to search the 20 sheets to find part 2 above (WM10562) and it then inserts 505,1107 into the first empty columns on the row it finds the WM10562.
the problem when using copy and paste no way will it work, tried all the different formatting options in Excel. If I enter the info manually into the cells it runs no problem -- over 400 lines in most of the Emails its a pain in the butt entering everything manually below is the macro that Figment helped me with earlier this week.
Sub Macro566()
Dim b As Long
RowCount = 1
With Sheets("Sheet1")
Do While .Range("C" & RowCount) <> ""
ID = .Range("C" & RowCount)
Val1 = .Range("D" & RowCount)
Val2 = .Range("E" & RowCount)
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Sheet1" Then
Set C = sh.Columns("A:A").Find(what:=ID, _
LookIn:=xlValues)
If Not C Is Nothing Then
A = 1
While C.Offset(0, A) <> "" And A < 253
A = A + 2
Wend
C.Offset(0, A) = Val1
C.Offset(0, A + 1) = Val2
End If
End If
Next sh
RowCount = RowCount + 1
Loop
End With
End Sub
Any help much appreciated
Sooty8 :banghead:
Scratching my head with this one -- I receive several Emails every week in CSV format for example 5042,WM10562,507,1107 - I copy and paste into Excel ColA do Text to Columns no problem then run a macro to search the 20 sheets to find part 2 above (WM10562) and it then inserts 505,1107 into the first empty columns on the row it finds the WM10562.
the problem when using copy and paste no way will it work, tried all the different formatting options in Excel. If I enter the info manually into the cells it runs no problem -- over 400 lines in most of the Emails its a pain in the butt entering everything manually below is the macro that Figment helped me with earlier this week.
Sub Macro566()
Dim b As Long
RowCount = 1
With Sheets("Sheet1")
Do While .Range("C" & RowCount) <> ""
ID = .Range("C" & RowCount)
Val1 = .Range("D" & RowCount)
Val2 = .Range("E" & RowCount)
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Sheet1" Then
Set C = sh.Columns("A:A").Find(what:=ID, _
LookIn:=xlValues)
If Not C Is Nothing Then
A = 1
While C.Offset(0, A) <> "" And A < 253
A = A + 2
Wend
C.Offset(0, A) = Val1
C.Offset(0, A + 1) = Val2
End If
End If
Next sh
RowCount = RowCount + 1
Loop
End With
End Sub
Any help much appreciated
Sooty8 :banghead: