Results 1 to 3 of 3
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts

    Macro to check if existing data

    I would like to amend my Macro to check if there is existing data on any of the sheets. If so, then to create a new sheet and to copy the data in the sheet created

    I have attached sample data (macro in sample data)
    Attached Files Attached Files

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,633
    Thanks
    115
    Thanked 648 Times in 591 Posts
    Howard,

    You can check to see if there is any data on the sheet with
    Code:
    Dim rng As Range
    Set rng = ActiveSheet.UsedRange
    If rng.Cells.Count = 1 And rng = "" Then 'SHEET IS BLANK
    There are many ways to add a new worksheet. Here are just a few:
    Code:
    Worksheets.Add Before:=Worksheets("Sheet2") 'BEFORE A NAMED WORKSHEET
    Worksheets.Add After:=Worksheets(Worksheets.Count) 'AFTER THE LAST WORKSHEET
    Worksheets.Add Before:=Worksheets(1) 'BEFORE THE FIRST WORKSHEET
    Copy data from one sheet to another cell by cell:
    Code:
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    LastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    For I = 2 To LastRow
        ws2.Cells(I, 1) = ws1.Cells(I, 1)
    Next I
    OR

    Copy data from one sheet to another using copy/paste:
    Code:
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    ws1.Range("A1:C6").Copy
    With ws2
        .Activate
        .Range("A1").Select
        .Paste
    End With
    Application.CutCopyMode = False
    HTH,
    Maud

  3. #3
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Thanks for your input Maud

    I would like to amend my code below, so that if I copy more data from a source file, It will copy the data after the last row in Col A

    Code:
     Sub copyDataFromSource()
    Dim sourceBook As Workbook
    Dim destinationBook As Workbook
    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim fileSource, sourceRow%, sourceRowCount&, destRow%
    With Application
        .ScreenUpdating = False
    End With
    fileSource = Application.GetOpenFilename
    If fileSource = False Or IsEmpty(fileSource) Then Exit Sub
    Set destinationBook = ThisWorkbook
    Set destinationSheet = destinationBook.Sheets("sheet1")
    Set sourceBook = Workbooks.Open(fileSource)
    Set sourceSheet = sourceBook.Sheets(1)
    sourceRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row
    sourceRowCount = sourceRow - 1
    destRow = destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Row
    destinationSheet.Rows(destRow + 1).Resize(sourceRowCount).Insert
    destRow = destRow
    
    With destinationSheet
        .Range("a" & destRow & ":ae" & destRow + sourceRowCount - 1).Value = sourceSheet.Range("a1:ae" & sourceRow).Value
       
    End With
    sourceBook.Close False
    With Application
        .ScreenUpdating = True
    End With
    Set sourceBook = Nothing
    Set destinationBook = Nothing
    Set sourceSheet = Nothing
    Set destinationSheet = Nothing
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •