VBA to read data from one worksheet and copy to another formatted one.

Guinaba · Aug 30th 2018

May I ask for some help here I need a Report in tabular format (sheet2) i.e.
[TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 784"]

[tr]

[td]

Vendor

[/td]

[td]

Company Code

[/td]

[td]

Name

[/td]

[td]

City

[/td]

[td]

Assignment

[/td]

[td]

DocumentNo

[/td]

[td]

Type

[/td]

[td]

Doc..Date

[/td]

[td]

Amount in Local Crcy

[/td]

[td]

LCurr

[/td]

[td]

Text

[/td]

[td]

Reference

[/td]

[/tr]

[/TABLE]

To populated this report I need to read the data from sheet2, however the data is formatted as below:
[TABLE="border: 0, cellpadding: 0, cellspacing: 0"]

[tr]

[TD="width: 101"]Vendor[/TD]
[TD="width: 64"] [/TD]
[TD="width: 64"] [/TD]
[TD="width: 185"] [/TD]
[TD="width: 64"]1000[/TD]
[TD="width: 89"] [/TD]
[TD="width: 64"] [/TD]
[TD="width: 71"] [/TD]
[TD="width: 137"] [/TD]
[TD="width: 64"] [/TD]
[TD="width: 146"] [/TD]
[TD="width: 157"] [/TD]

[/tr]

[tr]

[td]

Company Code

[/td]

[td][/td]

[td]

TA10

[/td]

[td][/td]

[/tr]

[tr]

[td][/td]

[/tr]

[tr]

[td]

Name

[/td]

[td][/td]

[TD="colspan: 2"]Grape Supplie[/TD]

[td][/td]

[/tr]

[tr]

[td]

City

[/td]

[td][/td]

[td]

Sydney

[/td]

[td][/td]

[/tr]

[tr]

[td][/td]

[/tr]

[tr]

[td][/td]

[/tr]

[tr]

[td][/td]

[td]

St

[/td]

[td]

Assignment

[/td]

[td][/td]

[td]

DocumentNo

[/td]

[td]

Type

[/td]

[td]

Doc..Date

[/td]

[td]

Amount in Local Crcy

[/td]

[td]

LCurr

[/td]

[td]

Text

[/td]

[td]

Reference

[/td]

[/tr]

[tr]

[td][/td]

[/tr]

[tr]

[td][/td]

[td]

1514

[/td]

[td][/td]

[td]

1500000136

[/td]

[td]

KZ

[/td]

[td]

10.08.2018

[/td]

[td]

50

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

TEST

[/td]

[/tr]

[tr]

[td][/td]

[td]

1073

[/td]

[td][/td]

[td]

1500000137

[/td]

[td]

KZ

[/td]

[td]

14.08.2018

[/td]

[td]

51

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

TEST_TRAD

[/td]

[/tr]

[tr]

[td][/td]

[td]

1521

[/td]

[td][/td]

[td]

1500000138

[/td]

[td]

KZ

[/td]

[td]

14.08.2018

[/td]

[td]

52

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

DDSDF1

[/td]

[/tr]

[tr]

[td][/td]

[td]

1905

[/td]

[td][/td]

[td]

1500000139

[/td]

[td]

KZ

[/td]

[td]

14.08.2018

[/td]

[td]

53

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

DDSDF1

[/td]

[/tr]

[tr]

[td][/td]

[td]

1541

[/td]

[td][/td]

[td]

1500000140

[/td]

[td]

KZ

[/td]

[td]

14.08.2018

[/td]

[td]

54

[/td]

[td]

NZD

[/td]

[td][/td]

[/tr]

[tr]

[td][/td]

[td]

1331

[/td]

[td][/td]

[td]

5100000305

[/td]

[td]

RE

[/td]

[td]

20.08.2018

[/td]

[td]

55

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

4500000776

[/td]

[/tr]

[tr]

[td][/td]

[td]

1055

[/td]

[td][/td]

[td]

5100000306

[/td]

[td]

RE

[/td]

[td]

20.08.2018

[/td]

[td]

56

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

4500000777

[/td]

[/tr]

[tr]

[td][/td]

[td]

1609

[/td]

[td][/td]

[td]

5100000075

[/td]

[td]

RE

[/td]

[td]

17.05.2018

[/td]

[td]

57

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

7500000146INV

[/td]

[/tr]

[tr]

[td][/td]

[td]

1548

[/td]

[td][/td]

[td]

5100000077

[/td]

[td]

RE

[/td]

[td]

17.05.2018

[/td]

[td]

58

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

7500000148INV

[/td]

[/tr]

[tr]

[td][/td]

[td]

1209

[/td]

[td][/td]

[td]

5100000087

[/td]

[td]

RE

[/td]

[td]

18.05.2018

[/td]

[td]

59

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

7500000183INV

[/td]

[/tr]

[tr]

[td][/td]

[td]

1794

[/td]

[td][/td]

[td]

5100000090

[/td]

[td]

RE

[/td]

[td]

18.05.2018

[/td]

[td]

60

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

7500000184CRDM

[/td]

[/tr]

[tr]

[td][/td]

[td]

1343

[/td]

[td][/td]

[td]

5100000089

[/td]

[td]

RE

[/td]

[td]

18.05.2018

[/td]

[td]

61

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

7500000184INV

[/td]

[/tr]

[tr]

[td][/td]

[td]

1251

[/td]

[td][/td]

[td]

5100000092

[/td]

[td]

RE

[/td]

[td]

28.05.2018

[/td]

[td]

62

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

7500000186CRDM

[/td]

[/tr]

[tr]

[td][/td]

[td]

1915

[/td]

[td][/td]

[td]

5100000091

[/td]

[td]

RE

[/td]

[td]

18.05.2018

[/td]

[td]

63

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

7500000186INV

[/td]

[/tr]

[tr]

[td][/td]

[td]

1782

[/td]

[td][/td]

[td]

5100000094

[/td]

[td]

RE

[/td]

[td]

18.05.2018

[/td]

[td]

64

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

7500000188CRDM

[/td]

[/tr]

[tr]

[td][/td]

[td]

1018

[/td]

[td][/td]

[td]

5100000093

[/td]

[td]

RE

[/td]

[td]

18.05.2018

[/td]

[td]

65

[/td]

[td]

NZD

[/td]

[td][/td]

[td]

7500000188INV

[/td]

[/tr]

[/TABLE]

Could you guys help me out here?

**Kenneth Hobson** · Aug 30th 2018

Welcome to the forum!

I guess we could paste the data to a sheet but I doubt it would paste as it is in yours. As such, to get the best help, it is best to attach and short example file. Click the paperclip icon, 3rd from top right of a reply to browse and upload.

You say sheet2 has the data posted but you want the "formatted" version on sheet2 too? Here again, an example file would better help us help you.

Guinaba · Aug 31st 2018

Hi Ken,

Thanks for your help! I have att. the file. Sheet1 is the data sheet (read/copy from) and the Sheet2 is the report sheet (past to) which needs a specific format.

Cheers,

Gilly

**Kenneth Hobson** · Sep 2nd 2018

Always test on a backup copy.

In a Module:

Code

Sub Main()
  Dim VendorCell As Range, SearchRange As Range
  Dim FirstVendorCell As String
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim r2 As Range, i As Long
  
  Set ws1 = Worksheets("Sheet1")
  Set ws2 = Worksheets("Sheet2")
  
  Set SearchRange = ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp))
  Set VendorCell = SearchRange.Find("Vendor", MatchCase:=True)


  If VendorCell Is Nothing Then
    MsgBox "No Vendor was found"
    Exit Sub
  Else
    FirstVendorCell = VendorCell.Address
    Do
      Set r2 = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      i = 1
      If VendorCell(, 5).Value = "*" Then Exit Sub 'Vendor, ws1 Column E
      Do While VendorCell(9 + i, 11).Value <> ""
        r2(i).Value = VendorCell(, 5).Value 'Vendor, ws1 Column E
        r2(i, 2).Value = VendorCell(9 + i, 15).Value 'Reference, ws1 Column O
        r2(i, 3).Value = VendorCell(9 + i, 11).Value '$, ws1 Column K
        r2(i, 4).Value = VendorCell(9 + i, 8).Value 'Date, ws1 Column H
        i = i + 1
      Loop
      Set VendorCell = SearchRange.FindNext(VendorCell)
    Loop While VendorCell.Address <> FirstVendorCell
  End If
End Sub

Display More

Guinaba · Sep 3rd 2018

Awesome! Thanks so much Ken! Much appreciate it! It works perfectly!

VBA to read data from one worksheet and copy to another formatted one.

Participate now!

Share