VBA to dynamically select the next range of used cells?

[ajjava]

I have a worksheet that contains several ranges of contiguous, non-blank cells (they look like tables but are not technically defined as such).

I need some code that will select the range of contiguous cells, copy it, then paste as a picture.
Then it needs to proceed to the next range contiguous cells, copy, paste as a picture, etc. etc.

This data is getting into Excel via an export from Business Objects.

The number of table-like structures can vary from sheet to sheet, and there are multiple sheets. I'd want the code to loop through all table-like structures and through all sheets.

Can anybody suggest the correct code? From the research I've done, I'm thinking of employing the SpecialCells method...am I barking up the right tree?

[/URL]https://i.imgur.com/jK8sFaL.jpg[/img][/IMG]

 

[igold]

The ranges are contiguous but it looks like they are separated by a blank column. In your image it appears as if Columns "L" and "X" are blank columns separating your three ranges. Is this correct...

Are the ranges always going to start on Row 2.

 

[ajjava]

Yes, always in row 2 and yes, separated by a tiny blank column. I've noticed that the data mostly starts in column A, but have seen it start in column B.

 

[igold]

Where (worksheet and cell) are the pictures of each table-like structure going to be pasted.

 

[ajjava]

Well, my goal is to have the pictures of the (sorta)tables replace the *actual* (sorta)tables. I haven't gotten that far in my design yet, though. I tend to go one TINY step at a time, on account of being only slightly above novice-level with VBA. To be honest, I don't really understand the value of the copy/paste, but it's what leadership wants. Ultimately, I'm hoping to end up with a vertical representation of the charts and their associated (sorta)tables. As it stands now, they are just laid out in one horizontal line (well, 2 if you look at it as charts on one line and tables on the next).

 

[igold]

Ok, I was kind of wondering why you would want to paste the data as a picture, but if that's what they want... See if this gets you close to what you are looking for. The code is pasting your picture in Row 40 right below the original data. I have indicated this line in Red. You will have to change this to paste your picture elsewhere.

Sub CopyPastePicture()


    Dim ws As Worksheet
    Dim uR As Range, fCol As Range
    Dim lCol As Long, lRow As Long, eCol As Long, nCol As Long
    
    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Worksheets
        lCol = 0
        eCol = 0
        nCol = 0
        Set uR = ActiveSheet.UsedRange
        Do Until nCol > uR.Columns.Count
            With uR
                Set fCol = Range(uR.Columns(1).Address).Offset(0, eCol)
                eCol = fCol.End(xlToRight).Column
                lRow = Cells(Rows.Count, eCol).End(xlUp).Row
            End With
            Range(Cells(2, fCol.Column), Cells(lRow, eCol)).Copy
[COLOR=#ff0000]            With Cells(40, fCol.Column)         ' Picture is being pasted here[/COLOR]
                .Select
                ActiveSheet.Pictures.Paste
            End With
            nCol = Cells(2, eCol).End(xlToRight).Column
        Loop
        Application.CutCopyMode = False
    Next
    Application.ScreenUpdating = True
    
End Sub

I hope this helps...

 

[igold]

I have an error in the above code, please use this one instead. Sorry about the confusion...

Sub CopyPastePicture()


    Dim ws As Worksheet
    Dim uR As Range, fCol As Range
    Dim lCol As Long, lRow As Long, eCol As Long, nCol As Long
    
    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Worksheets
        ws.Select
        lCol = 0
        eCol = 0
        nCol = 0
        Set uR = ActiveSheet.UsedRange
        Do Until nCol > uR.Columns.Count
            With uR
                Set fCol = Range(uR.Columns(1).Address).Offset(0, eCol)
                eCol = fCol.End(xlToRight).Column
                lRow = Cells(Rows.Count, eCol).End(xlUp).Row
            End With
            Range(Cells(2, fCol.Column), Cells(lRow, eCol)).Copy
[COLOR=#ff0000]            With Cells(40, fCol.Column)         ' Picture is being pasted here[/COLOR]
                .Select
                ActiveSheet.Pictures.Paste
            End With
            nCol = Cells(2, eCol).End(xlToRight).Column
        Loop
        Application.CutCopyMode = False
    Next
    Application.ScreenUpdating = True
    MsgBox "Operation Complete", , "Copying Complete"
    
End Sub

 

[ajjava]

So, the charts themselves are already picture objects and don't need to be copied. When I tested the code above, it copied the charts (row 1) and then the table data from only row 2. It copied ALL the charts and ALL the table data and pasted it as one big picture object. What i'm looking to do is to select each individual table and paste it alone as a picture object. I'm adding a couple of screen grabs to try and illustrate. Essentially, rather than having a bunch of charts and tables horizontally across the worksheet, I'll instead have groups of 2 (2 charts, 2 tables, 2 more charts, 2 more tables, etc.) going vertically down the worksheet.


BEFORE

[/URL][/IMG]

AFTER

[/URL][/IMG]

 

[igold]

I did understand your requirement, I gave you code which was clearly flawed. I did test it, just not with pictures above Row 2. I regret my error.

See if this is any better. The only caveat I see with this code, is that if your first cell with data is not Cell A2 or Cell B2, the code will fail.

Sub CopyPastePicture()


    Dim ws As Worksheet
    Dim FirstCell As Range, LastCell As Range
    Dim lCol As Long, lRow As Long, eCol As Long, nCol As Long, c As Long
    Dim fc As Long
    
    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Worksheets
        ws.Select
        If Not ws.Cells(2, 1).End(xlToRight).Column = 2 Then
            Set FirstCell = Range("A2")
        Else
            Set FirstCell = Range("B2")
        End If
        Set LastCell = ws.Cells.SpecialCells(xlCellTypeLastCell)
        lCol = 0
        eCol = 0
        nCol = 0
        lCol = Cells(2, Columns.Count).End(xlToLeft).Column
        Do Until nCol > lCol
            fc = nCol
            If fc < 3 Then fc = FirstCell.Column
            eCol = Cells(2, fc).End(xlToRight).Column
            If eCol = 16384 Then GoTo SkipSheet
            lRow = Cells(Rows.Count, eCol).End(xlUp).Row
            Range(Cells(2, fc), Cells(lRow, eCol)).Copy
            With Cells(40, fc)         ' Picture is being pasted here
                .Select
                ActiveSheet.Pictures.Paste
            End With
            nCol = Cells(2, eCol).End(xlToRight).Column
        Loop
        Application.CutCopyMode = False
SkipSheet:
    Next
    Application.ScreenUpdating = True
    MsgBox "Operation Complete", , "Copying Complete"
    
End Sub

 

[Fluff]

Cross posted http://www.vbaexpress.com/forum/sho...range-of-cells-on-a-worksheet-then-copy-paste

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.