Copy from range

arijitirf

Board Regular
Joined
Aug 11, 2016
Messages
70
HI!!!

Code:
[COLOR=#333333][COLOR=#333333]Sub getSum()[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Dim strDate As String[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Dim ws As Worksheet[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]strDate = InputBox("Insert date in format mm/yyyy", "User date", Format(Now(), "mm/yyyy"))[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]If IsDate(strDate) Then[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]strDate = Format(CDate(strDate), "mm/yyyy")[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Else[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]MsgBox "Wrong date format. Please try again."[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Exit Sub[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]End If[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Dim ldateto As Long[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Dim ldatefrom As Long[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Dim LastRow As Long[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Dim ThisMonth As Integer[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Dim ThisYear As Long[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Dim qty As Long[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]ThisMonth = Month(strDate)[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]ThisYear = Year(strDate)[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]ldatefrom = DateSerial(ThisYear, ThisMonth, 1)[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]ldateto = DateSerial(ThisYear, ThisMonth + 1, 0)[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]For Each ws In Sheets[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]ws.Range("F7:F" & LastRow).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]qty = qty + WorksheetFunction.Sum(ws.Range("I7:I" & LastRow).SpecialCells(xlCellTypeVisible))[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]If ws.AutoFilterMode = True Then ws.AutoFilterMode = False[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Next ws[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]If qty = 0 Then[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]MsgBox ("There is no data for " & MonthName(ThisMonth) & ".")[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]Else[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]MsgBox ("The sum of values for " & MonthName(ThisMonth) & "/" & ThisYear & " is " & qty & ".")[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]End If[/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333]End Sub


Is there any way to copy data in "F" and "I" for each sheet and paste it to a sheet within the workbook with sheet name?


Example: If I am searching for the month of September' 2017 and found 5 rows in Sheet 1, Sheet 5 and Sheet 32 then it will paste the value found in 3 different sheets within a new sheet like following;


Sheet 1 27-09-2017 10
Sheet 1 30-09-2017 02
Sheet 5 13-09-2017 30
Sheet 5 22-09-2017 14
Sheet 32 12-09-2017 11


Thanks in advance..[/COLOR][/COLOR]
 
Last edited by a moderator:

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,661
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Possibly something like this

Code:
    Dim R1 As Range, R2 As Range
    For Each ws In Sheets
        LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        ws.Range("F7:F" & LastRow).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        qty = qty + WorksheetFunction.Sum(ws.Range("I7:I" & LastRow).SpecialCells(xlCellTypeVisible))

        Set R1 = ws.Range("F7:F" & LastRow).SpecialCells(xlCellTypeVisible)
        Set R2 = ws.Range("I7:I" & LastRow).SpecialCells(xlCellTypeVisible)

        With Worksheets("SomeSheetInThisWorkbook")
            R1.Copy .Range("A" & .Rows.Count).End(xlUp)
            R2.Copy .Range("B" & .Rows.Count).End(xlUp)
        End With

        If ws.AutoFilterMode = True Then ws.AutoFilterMode = False
    Next ws
 

arijitirf

Board Regular
Joined
Aug 11, 2016
Messages
70
Thanks for your prompt reply.This is working but page name is displaying. Another problem is, in my workbook there are some range that are merged. Is there any tricks to copy merged range? Thanks..
 

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,661
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Use of merged cells within a data table often will enormously complicate operations I want to perform on those cells, and I personally take pains not to use merged cells in data tables.
 

Forum statistics

Threads
1,171,359
Messages
5,875,140
Members
433,103
Latest member
inferno657

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top