multiple sheet data to single sheet record

[willsnake]

good day,

I am here again seeking help since I was not able to find any solution upon searching the net...

I have an excel sheet that has more than 100 sheets, my goal is to simplify the data on each sheet into single sheet.

each sheet has normal label like name, date, numbers, etc.

my single sheet output will have the table which are the headings are the labels, and rows will be the data from labels.

My request now is how to make vba that will make the data on each sheet will be recorded in a single sheet.

I have started a code:

<code>

[/FONT]Sub record()
Worksheets("data").Range("z2").Value = ActiveSheet.Index
Do Until Worksheets("data").Range("z2").Value = 1
ActiveSheet.Select
NewRow = Worksheets("data").Range("z1").Value
Worksheets("data").Cells(NewRow, 1).Value = Application.WorksheetFunction.VLookup("P.O Date*", Range("f6:g100"), 2, False).Value
Worksheets("data").Cells(NewRow, 13).Value = Application.WorksheetFunction.VLookup("Supplier*", Range("a6:c100"), 3, False).Value
Worksheets("data").Cells(NewRow, 16).Value = Application.WorksheetFunction.VLookup("Amount:*", ActiveSheet.Range("h1:i100"), 2, False).Value
Worksheets("data").Cells(NewRow, 14).Value = Format(Application.WorksheetFunction.VLookup("Date of Delivery:*", ActiveSheet.Range("a1:c100"), 3, False).Value, "[$-F800]dddd, mmmm dd, yyyy")
Worksheets("data").Cells(NewRow, 3).Value = Application.WorksheetFunction.VLookup("requested by*", ActiveSheet.Range("a1:c100"), 2, False).Value
Worksheets("data").Cells(NewRow, 12).Value = Application.WorksheetFunction.VLookup("P.O No.*", ActiveSheet.Range("f1:g100"), 2, False).Value
Worksheets("data").Cells(NewRow, 17).Value = Application.WorksheetFunction.VLookup("Mode of Procurement*", ActiveSheet.Range("f1:g100"), 2, False).Value
Worksheets("data").Cells(NewRow, 2).Value = "PR No.: " & Application.WorksheetFunction.VLookup("PR No.*", ActiveSheet.Range("h1:i100"), 2, False).Value
If ActiveSheet.Index = 1 Then
Worksheets(1).Select
End
Else
ActiveSheet.Previous.Select
End If
Loop
End Sub<code>[FONT=Verdana]

And I tried running the code, I am stuck on vlookup saying that it is lacking object, been all searching different samples, but I cant find any for my problem..

Thank you in advance for the help...</code></code>

 

[Logit]

.
The following will copy all sheets in a workbook to a single sheet named "Import". Paste this macro into a Routine Module :

Option Explicit




Public Sub CombineDataFromAllSheets()


    Dim wksSrc As Worksheet, wksDst As Worksheet
    Dim rngSrc As Range, rngDst As Range
    Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
    
    'Notes: "Src" is short for "Source", "Dst" is short for "Destination"
    
    'Set references up-front
    Set wksDst = ThisWorkbook.Worksheets("Import")
    lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below
    lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below
    
    'Set the initial destination range
    Set rngDst = wksDst.Cells(lngDstLastRow, 1)
    
    'Loop through all sheets
    For Each wksSrc In ThisWorkbook.Worksheets
    
        'Make sure we skip the "Import" destination sheet!
        If wksSrc.Name <> "Import" Then
            
            'Identify the last occupied row on this sheet
            lngSrcLastRow = LastOccupiedRowNum(wksSrc)
            
            'Store the source data then copy it to the destination range
            With wksSrc
                Set rngSrc = .Range("A1:Z100")
                rngSrc.Copy Destination:=rngDst
            End With
            
            'Redefine the destination range now that new data has been added
            lngDstLastRow = LastOccupiedRowNum(wksDst)
            Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
            
        End If
    
    Next wksSrc


End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last row
'OUTPUT      : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng + 1   '<-- the + 1 places a blank row between tables
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last column
'OUTPUT      : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column
        End With
    Else
        lng = 1
    End If
    LastOccupiedColNum = lng
End Function

 

[willsnake]

The sheets are in a FORM format, I will be only be needing the important details
Supplier:	tttttttttttttttttttttttt	P.O No.	18-03-073
Address:	North Montilla Blvd. Butuan City		Date:	8-Mar-18
			Mode of Procurement	shopping
Place of Delivery:	division office	Delivery Term	door to door
Date of Delivery:		Friday, March 16 2018	Payment Term:	As to availability of funds
The RED words will be one of the Column, and the blue are the data.. and it will be recorded in data form in a destination sheet... This will be header in the destination sheet Date PR No. Requisitioner Purpose Unit Item Description Quantity Unit Cost Total Cost Series No. Status update PO No. Supplier Delivery Date Actual Delivery Amount Procurement Mode2 <tbody> </tbody>

<tbody>
</tbody>

Thank you for the reply sir Logit, will try to tinker the code u shared and will update if I am successful...

 

[willsnake]

Supplier:	tttttttttttttttttttttttttttttt	P.O No.	18-03-073 <tbody> </tbody>
Address:	North Montilla Blvd. Butuan City		Date:	8-Mar-18
			Mode of Procurement	shopping
Gentlemen:
Please furnish this Office the following articles subject to terms and condition containing herein:
Place of Delivery:	division office	Delivery Term	door to door
Date of Delivery:	Friday, March 16 2018	Payment Term:	As to availability of funds

<tbody>
</tbody>

****** id="cke_pastebin" style="position: absolute; top: 31px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">

18-03-073

<tbody>
</tbody>