Copy paste problem

V

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,232
Hi All,
Im facing copy paste problem in red line. Can anyone suggest, the correction here..

Code: 
Sub fnCombine()
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If ws.Name = "Atlantic" Or ws.Name = "South" Or ws.Name = "Midwest" Or ws.Name = "Northeast" Or ws.Name = "CA" Or ws.Name = "West" Or ws.Name = "SELECT" Then
    ws.Activate
    Cells(1, 1).Select
    i = Range("A1:A5000").Find("Monthly", Range("A1"), xlValues, xlWhole, xlByColumns, xlNext).Row
    x = i + 3
    LC = Cells(3, Columns.Count).End(xlToLeft).Column
    bLR = Range(Range("B5"), Range("B5").End(xlDown)).Rows.Count
    
    If ws.Name = "Atlantic" Then
    ws.Range(Cells(x, 1), Cells(x + 1, LC)).Select
    Selection.Copy
    Worksheets("Combine").Range("A1").PasteSpecial xlPasteValues
    Worksheets("Combine").Range("A1").PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    
    Worksheets("Combine").Select
    j = Range("A" & Rows.Count).End(xlUp).Row
    
    ws.Activate
    ws.Range(Cells(x + 2, 1), Cells(x + 1 + bLR, LC)).Select
    Selection.Copy
[COLOR=#ff0000]    Worksheets("Combine").Range("A" & j).Select[/COLOR]
    ActiveSheet.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Else
    
    End If


End If
Next ws
End Sub
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
You cannot select a cell or range on a sheet unless it is the active sheet. Also, you don't have to select a range to copy it. It is good practice to define all your variables. Try this revised code (untested):
Code: 
Sub fnCombine()
    Dim i As Long, x As Long
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = "Atlantic" Or ws.Name = "South" Or ws.Name = "Midwest" Or ws.Name = "Northeast" Or ws.Name = "CA" Or ws.Name = "West" Or ws.Name = "SELECT" Then
            ws.Activate
            i = Range("A1:A5000").Find("Monthly", Range("A1"), xlValues, xlWhole, xlByColumns, xlNext).Row
            x = i + 3
            LC = Cells(3, Columns.Count).End(xlToLeft).Column
            bLR = Range(Range("B5"), Range("B5").End(xlDown)).Rows.Count
            If ws.Name = "Atlantic" Then
                ws.Range(Cells(x, 1), Cells(x + 1, LC)).Copy
                Worksheets("Combine").Range("A1").PasteSpecial xlPasteValues
                Worksheets("Combine").Range("A1").PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
                ws.Range(ws.Cells(x + 2, 1), ws.Cells(x + 1 + bLR, LC)).Copy
                With Worksheets("Combine")
                    .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
                End With
                Application.CutCopyMode = False
            End If
        End If
    Next ws
End Sub
I'm a little confused on what you are trying to achieve. You loop through all the sheets named in the code but the copy/paste is performed only in sheet "Atlantic". Is that what you want to do?
 
Last edited:
Upvote 0
Hi, Thanks for reply such a nice code.

Your query is correct. I'm confuse here actually.
See the RED highlighted. As Atlantic is my 1st sheet, I want to copy and paste headers only one time. This is what im doing in red color code in "Combine" sheet.
But, yes, logic goes wrong...
It didn't then copying Atlantic data..:confused:

Or Else, I can do like..copy the header data plus data whatever and paste it into "Combine" sheet and next time loop, I will skip header rows and will try to copy the data only...Let me try...not so easy for me..

Code: 
Dim i As Long, x As Long
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
    If ws.Name = "Atlantic" Or ws.Name = "South" Or ws.Name = "Midwest" Or ws.Name = "Northeast" Or ws.Name = "CA" Or ws.Name = "West" Or ws.Name = "SELECT" Then
        ws.Activate
        i = Range("A1:A5000").Find("Monthly", Range("A1"), xlValues, xlWhole, xlByColumns, xlNext).Row
        x = i + 3
        LC = Cells(3, Columns.Count).End(xlToLeft).Column
        bLR = Range(Range("B5"), Range("B5").End(xlDown)).Rows.Count
[COLOR=#ff0000]        If ws.Name = "Atlantic" Then[/COLOR]
[COLOR=#ff0000]            ws.Range(Cells(x, 1), Cells(x + 1, LC)).Copy[/COLOR]
[COLOR=#ff0000]            Worksheets("Combine").Range("A1").PasteSpecial xlPasteValues[/COLOR]
[COLOR=#ff0000]            Worksheets("Combine").Range("A1").PasteSpecial xlPasteFormats[/COLOR]
[COLOR=#ff0000]            Application.CutCopyMode = False[/COLOR]
            Else
            ws.Range(ws.Cells(x + 2, 1), ws.Cells(x + 1 + bLR, LC)).Copy
            With Worksheets("Combine")
                .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
            End With
            Application.CutCopyMode = False
        End If
    End If
Next ws

mumps said:
You cannot select a cell or range on a sheet unless it is the active sheet. Also, you don't have to select a range to copy it. It is good practice to define all your variables. Try this revised code (untested):
Code: 
Sub fnCombine()
    Dim i As Long, x As Long
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = "Atlantic" Or ws.Name = "South" Or ws.Name = "Midwest" Or ws.Name = "Northeast" Or ws.Name = "CA" Or ws.Name = "West" Or ws.Name = "SELECT" Then
            ws.Activate
            i = Range("A1:A5000").Find("Monthly", Range("A1"), xlValues, xlWhole, xlByColumns, xlNext).Row
            x = i + 3
            LC = Cells(3, Columns.Count).End(xlToLeft).Column
            bLR = Range(Range("B5"), Range("B5").End(xlDown)).Rows.Count
            If ws.Name = "Atlantic" Then
                ws.Range(Cells(x, 1), Cells(x + 1, LC)).Copy
                Worksheets("Combine").Range("A1").PasteSpecial xlPasteValues
                Worksheets("Combine").Range("A1").PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
                ws.Range(ws.Cells(x + 2, 1), ws.Cells(x + 1 + bLR, LC)).Copy
                With Worksheets("Combine")
                    .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
                End With
                Application.CutCopyMode = False
            End If
        End If
    Next ws
End Sub
I'm a little confused on what you are trying to achieve. You loop through all the sheets named in the code but the copy/paste is performed only in sheet "Atlantic". Is that what you want to do?
Click to expand...
 
Upvote 0
Hi,
Please ignore my post no #3 ..
I got the solution..

Problem is at paste..I will show which line..
Code: 
If ws.Name = "Atlantic" Then
            ws.Range(Cells(x, 1), Cells(x + 1 + bLR, LC)).Copy
            Worksheets("Combine").Range("A1").PasteSpecial xlPasteValues
            Worksheets("Combine").Range("A1").PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
            Else
            ws.Range(ws.Cells(x + 2, 1), ws.Cells(x + 1 + bLR, LC)).Copy
            With Worksheets("Combine")
[COLOR=#ff0000]                .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues[/COLOR]
            End With
            Application.CutCopyMode = False
        End If
Here..I want plus one row..That mean take the count of last row and plus 1 so the next data will copy below that correctly..
 
Upvote 0
Try:
Code: 
.Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row).Offset(1,0).PasteSpecial xlPasteValues
 
Upvote 0
Code: 
With Worksheets("Combine")
                    .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
                    .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteFormats
End With
Not getting same format.


The other main and important issue, just got observed that, all this sheet's are Grouped by rows.
Means, as Im finding this = "Monthly". This places at very down rows..That is row number 1104 starts monthly data table.
All above, are weekly data placed in such a format like...Week 1...Monday Tuesday Wedn...Friday.. And this is grouped..

B'coz of this grouping..in below line of code im trying to achieve are not get possible for me.
Code: 
bLR = Range(Range("B5"), Range("B5").End(xlDown)).Rows.Count

Since plus sign (Grouping Sign) till row number 182...from B5 the actual employee counts not getting..
 
Upvote 0
Any possibility on this..

As manually click on that + symbol, I can write a code line like..

Range("A182").select
Range("A182").UnGrouped

But, this ungroup should not remove permanant grouping...only for coding purpose remove...can we do this..
 
Upvote 0
Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data. Include a sheet that shows what you want the data to look like after the macro is run. You may have to compose this "after" sheet manually.
 
Upvote 0
 
Upvote 0
Week 1 = A1
blank row = A2

REGION = B186
Leaves = A187

Week 1
REGION
LeavesEmp IDTeam Member NameStatusAAABACADAEAFAGAHAIAJAKALSweepCore Others(Mins)SME Time(Mins)ReworkTechnical meet
11A1920240000000000000000
02B24003416000000000000000
03C2400064500003000000016000
04D2400270000000000000000
05E2400280000000000000000
06F14402700000000000008000
07G2160330000000000000000
08H2400190000000000000000
09I2400210000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
000000000000000000000
Team Total1992021380500003000000024000
Week 2
REGION
LeavesEmp IDTeam Member NameStatusAAABACADAEAFAGAHAIAJAKALSweepCore Others(Mins)SME Time(Mins)ReworkTechnical meet
01A240023010000000000000030
02B2400432000000000000105050

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>
Click to expand...




Data Between A2 and A186 are Gets grouped.. At the Extreme Left of excel sheet, i.e. left to Row numbers..I have symbol like this "+"...If i clicked on this symbol, then the above data will gets expand like this..
Week 1
REGIONMon-02/04
LeavesEmp IDTeam Member NameStatusAAABACADAEAFAGAHAIAJAKALSweepCore Others(Mins)SME Time(Mins)ReworkTechnical meet
1A4806
2B4807
3C480 15
4D4804
5E4806
6F4808 80
7G4808
8H4803
9I4802
Team Total432044150000000000008000
REGIONTue-03/04
LeavesEmp IDTeam Member NameStatusAAABACADAEAFAGAHAIAJAKALSweepCore Others(Mins)SME Time(Mins)ReworkTechnical meet
1A4805
2B4807
3C480 95 40
4D4806
5E4805
6F48010
7G4807
8H4804
9I4805
00
00
00
00
00
00
00
00
00
00
00
00
00
00
00
00
00
00
00
00
00
00
Team Total43204995000000000004000
REGIONWed-04/04
LeavesEmp IDTeam Member NameStatusAAABACADAEAFAGAHAIAJAKALSweepCore Others(Mins)SME Time(Mins)ReworkTechnical meet
1A4806
2B48064
3C480 13 60
4D4806
5E4805
6F4809
7G4807
8H4802
9I4805

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
VBA Rows Count Not Resetting
Replies
2
Views
285
BrainDiseasee
B
D
  • Question
VBA Not Running
2
Replies
15
Views
761
dawnmichelle
D
V
  • Question
Copy each sheet to new workbook, paste values and save to specific folder
Replies
7
Views
159
JerrExcel
JerrExcel
B
  • Question
If sheet title is NOT this Monday's date then execute code
Replies
3
Views
422
MARK858
MARK858
S
  • Solved
VBA Code to select a variable folder path, find multiple .xls then copy same named worksheets into new workbook.
Replies
4
Views
530
SteveD01
S

Forum statistics

Threads
1,216,031
Messages
6,128,424
Members
449,450
Latest member
gunars

Share this page

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
Back
Top