djmnon
New Member
- Joined
- Mar 22, 2022
- Messages
- 19
- Office Version
- 365
- 2021
- 2019
- 2016
- 2013
- 2010
- 2007
- Platform
- Windows
I have a Main Sheet containing orders which has 10000 records
1. I need to create 3 separate sheets by selecting some filters on the main sheet (Master). This I have already done by creating a Macro and performing the steps needed.
2. Now from the 3 seperate sheets I need to combine them and paste it in a single sheet. So for eg :- 1st sheet has 5000 records, 2nd has 3000 and 3rd has 1500 record
I want to combine these into one sheet append and paste it so 5000 then from 5001 the 3000 records from second sheet will be appended and a final sheet will be created.
I have managed to do this but I'm not able to specify the sheets where the VBA should select the records only from specific sheets and append them together. Its also adding the records from the Master sheet. Please help
Below is the code :-
1. I need to create 3 separate sheets by selecting some filters on the main sheet (Master). This I have already done by creating a Macro and performing the steps needed.
2. Now from the 3 seperate sheets I need to combine them and paste it in a single sheet. So for eg :- 1st sheet has 5000 records, 2nd has 3000 and 3rd has 1500 record
I want to combine these into one sheet append and paste it so 5000 then from 5001 the 3000 records from second sheet will be appended and a final sheet will be created.
I have managed to do this but I'm not able to specify the sheets where the VBA should select the records only from specific sheets and append them together. Its also adding the records from the Master sheet. Please help
Below is the code :-
Rich (BB code):
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("Sheet8")
lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!
'Set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
'Loop through all sheets
For Each wksSrc In ThisWorkbook.Sheets
'Make sure we skip the "Import" destination sheet!
If wksSrc.Name <> "Sheet8" 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(.Cells(1, 21), .Cells(lngSrcLastRow, lngLastCol))
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
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
Last edited by a moderator: