• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Transfer data from two sheets to a new workbook

D

Danilão

New Member
Good afternoon, everyone
I needed to add a similar scenario to the macro in this workbook, just like with the Cash Flow, but this time using the Pending sheet.
Filter by date and save it in the same workbook as the Cash Flow, with dates from last month.
 

Attachments

vletm said:
Explain in few words ...
... how did You get from Cash Flow 02-2026 that Pending?
Click to expand...
There is already a macro that filters only last month's data in the Cash Flow spreadsheet.
I just need one like that for the “Pending” items, and create a new worksheet in the workbook generated by the macro, containing these pending items .
 
Did You explain ... how did You get something?
Your title gives an image about from two sheets to a new workbook ...
... and ...
Your above ... skipped - how? ... hmm? something to a new worksheet and so?
Did I miss something?
... or did You miss something?
 
vletm said:
Did You explain ... how did You get something?
Your title gives an image about from two sheets to a new workbook ...
... and ...
Your above ... skipped - how? ... hmm? something to a new worksheet and so?
Did I miss something?
... or did You miss something?
Click to expand...
Use the same filtering process as last month in the cash flow report for the “Pending” worksheet.
If there are any pending items from last month, create a separate worksheet in the new workbook.
That's it.
 
try
Code: 
Sub test()
    Dim d(1) As Date, r As Range, f$, temp, ws As Worksheet
    Application.ScreenUpdating = False
    d(0) = DateSerial(Year(Date), Month(Date) - 1, 1)
    d(1) = WorksheetFunction.EoMonth(d(0), 0)
    Set ws = Sheets.Add
    With Sheets("cash flow")
        Set r = .[m1:m2]: temp = r.Value
        With .ListObjects(1)
            .HeaderRowRange.Resize(, 6).Copy ws.[a1]
            f = .Range(.ListColumns.Count + 1).Address(0, 0)
            r(2).Formula = Replace("=and(#>=" & CLng(d(0)) & ",#<=" & CLng(d(1)) & ")", "#", f)
            .Range.AdvancedFilter 2, r, ws.[a1].CurrentRegion
            r.Value = temp
        End With
    End With
    f = Replace(CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name), "Cash Flow ", "")
    If ws.[a1].CurrentRegion.Rows.Count > 1 Then
        ws.Copy
        With ActiveWorkbook
            .Sheets(1).Name = "Sheet1"
            .Sheets(1).Columns.AutoFit
            Application.DisplayAlerts = False
            .SaveAs ThisWorkbook.Path & "\" & f & "_" & Format$(d(0), "mmm"), 51
            .Close
        End With
    End If
    ws.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
 
jindon said:
try
Code: 
Sub test()
    Dim d(1) As Date, r As Range, f$, temp, ws As Worksheet
    Application.ScreenUpdating = False
    d(0) = DateSerial(Year(Date), Month(Date) - 1, 1)
    d(1) = WorksheetFunction.EoMonth(d(0), 0)
    Set ws = Sheets.Add
    With Sheets("cash flow")
        Set r = .[m1:m2]: temp = r.Value
        With .ListObjects(1)
            .HeaderRowRange.Resize(, 6).Copy ws.[a1]
            f = .Range(.ListColumns.Count + 1).Address(0, 0)
            r(2).Formula = Replace("=and(#>=" & CLng(d(0)) & ",#<=" & CLng(d(1)) & ")", "#", f)
            .Range.AdvancedFilter 2, r, ws.[a1].CurrentRegion
            r.Value = temp
        End With
    End With
    f = Replace(CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name), "Cash Flow ", "")
    If ws.[a1].CurrentRegion.Rows.Count > 1 Then
        ws.Copy
        With ActiveWorkbook
            .Sheets(1).Name = "Sheet1"
            .Sheets(1).Columns.AutoFit
            Application.DisplayAlerts = False
            .SaveAs ThisWorkbook.Path & "\" & f & "_" & Format$(d(0), "mmm"), 51
            .Close
        End With
    End If
    ws.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Click to expand...
Great job, Jindon!!!
However, I need the code to also run through the “Pending” sheet. If there are any pending items from last month, create a sheet next to Sheet1 with those pending items.
 
OK, see if this is how you wanted.
Code: 
Sub test()
    Dim d(1) As Date, r As Range, f$, temp, ws As Worksheet, wb As Workbook, e, n&
    Application.ScreenUpdating = False
    d(0) = DateSerial(Year(Date), Month(Date) - 1, 1)
    d(1) = WorksheetFunction.EoMonth(d(0), 0)
    Set ws = Sheets.Add
    For Each e In Array(Array("Cash Flow", "B11:G11"), Array("Pending", "A1:F1"))
        ws.UsedRange.Clear
        With ThisWorkbook.Sheets(e(0))
            Set r = .[m1:m2]: temp = r.Value
            With .Range(e(1)).Resize(.Cells(Rows.Count, Range(e(1)).Column).End(xlUp).Row - Range(e(1)).Row + 1)
                .Rows(1).Copy ws.[a1]
                f = .Range("a2").Address(0, 0)
                r(2).Formula = Replace("=and(#>=" & CLng(d(0)) & ",#<=" & CLng(d(1)) & ")", "#", f)
                .AdvancedFilter 2, r, ws.[a1].CurrentRegion
                r.Value = temp
            End With
        End With
        If ws.[a1].CurrentRegion.Rows.Count > 1 Then
            n = n + 1
            If wb Is Nothing Then Set wb = Workbooks.Add
            With wb
                If .Sheets.Count < n Then .Sheets.Add , .Sheets(n - 1)
                .Sheets(n).Name = "Sheet" & n
                ws.Cells.Copy .Sheets(n).[a1]
                .Sheets(n).Columns.AutoFit
            End With
        End If
    Next
    If Not wb Is Nothing Then
        f = Replace(CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name), "Cash Flow ", "")
        Application.DisplayAlerts = False
        wb.SaveAs ThisWorkbook.Path & "\" & f & "_" & Format$(d(0), "mmm"), 51
        wb.Close
    End If
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
 
jindon said:
OK, see if this is how you wanted.
Code: 
Sub test()
    Dim d(1) As Date, r As Range, f$, temp, ws As Worksheet, wb As Workbook, e, n&
    Application.ScreenUpdating = False
    d(0) = DateSerial(Year(Date), Month(Date) - 1, 1)
    d(1) = WorksheetFunction.EoMonth(d(0), 0)
    Set ws = Sheets.Add
    For Each e In Array(Array("Cash Flow", "B11:G11"), Array("Pending", "A1:F1"))
        ws.UsedRange.Clear
        With ThisWorkbook.Sheets(e(0))
            Set r = .[m1:m2]: temp = r.Value
            With .Range(e(1)).Resize(.Cells(Rows.Count, Range(e(1)).Column).End(xlUp).Row - Range(e(1)).Row + 1)
                .Rows(1).Copy ws.[a1]
                f = .Range("a2").Address(0, 0)
                r(2).Formula = Replace("=and(#>=" & CLng(d(0)) & ",#<=" & CLng(d(1)) & ")", "#", f)
                .AdvancedFilter 2, r, ws.[a1].CurrentRegion
                r.Value = temp
            End With
        End With
        If ws.[a1].CurrentRegion.Rows.Count > 1 Then
            n = n + 1
            If wb Is Nothing Then Set wb = Workbooks.Add
            With wb
                If .Sheets.Count < n Then .Sheets.Add , .Sheets(n - 1)
                .Sheets(n).Name = "Sheet" & n
                ws.Cells.Copy .Sheets(n).[a1]
                .Sheets(n).Columns.AutoFit
            End With
        End If
    Next
    If Not wb Is Nothing Then
        f = Replace(CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name), "Cash Flow ", "")
        Application.DisplayAlerts = False
        wb.SaveAs ThisWorkbook.Path & "\" & f & "_" & Format$(d(0), "mmm"), 51
        wb.Close
    End If
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Click to expand...
That’s exactly right, Jindon.
Genius !!!!

Thank you so much !!!
 
You must log in or register to reply here.
Back
Top