Need code..

[VBABEGINER]

Hi All,

I need assistance in entire code please..
It's easy to make the code b'coz, formats of the sheet are same..

I have 7-8 sheets. I want all data combine in single sheet..

Format of sheet like below--

Columns A, B, C, D & E are merged from row 2 to 24. i.e 23 row's.

Column F contains, region names which are fix 23.

From Col G, my monthly data starts. Like,

Col G - Jan'18
Col H - Feb'18
Col I - Mar'18
Col J - Apr'18
Col K - YTD'18

Col L - Comments

Now, Sheet1 person only have one metric data hence data is onlt till row 2 to 24. (Fix)

Sheet2 person also have data row 2 to 24, as only have one metric data.

Sheet3 person have 5 metric data hence rows grouping like this..
2 to 24
25 to 47
48 to ....and more..

So, all this data gets combine in one sheet..

Can anyone help on this..

 

[VBABEGINER]

Till now I have designed..

Dim i As Long, x As Long, j As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
    If ws.Name = "Combine" Then
    Else
        ws.Activate
        i = Range("F" & Rows.Count).End(xlUp).Row
        LC = Cells(1, Columns.Count).End(xlToLeft).Column
'        Range("A2:L" & i).Select
'        Worksheets("Combine").Select
        
        
        ws.Range(ws.Cells(2, 1), ws.Cells(i, LC)).Copy
        With Worksheets("Combine")
            .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row).Offset(1, 0).Paste xlpaste
        End With

 

[VBABEGINER]

Hello All,

with this regards, I have designed the code..

Sub fnCombine()
Dim i As Long, x As Long, j As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
    If ws.Name = "Combine" Then
    Else
        ws.Activate
        i = Range("F" & Rows.Count).End(xlUp).Row
        LC = Cells(1, Columns.Count).End(xlToLeft).Column
        If ws.Index = 1 Then
            Range("A1:L" & i).Select
            Selection.Copy
            Worksheets("Combine").Select
            Range("A1").Select
            ActiveSheet.Paste
        Else
        Range("A2:L" & i).Select
        Selection.Copy
        Worksheets("Combine").Select
        j = Range("F" & Rows.Count).End(xlUp).Row
        Range("A" & j + 1).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        End If
    End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

But Now I have some other view requires.. Therefore, above code will not helpful more.


I trying to re-design the code like,

Sub fnCombine()
Dim i As Long, j As Long
Dim ws As Worksheet


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
For Each ws In ThisWorkbook.Sheets
    If ws.Name = "Combine" Then
    Else
        ws.Activate
        i = Range("F" & Rows.Count).End(xlUp).Row
        If ws.Index = 1 Then
            Range("A1:G" & i).Select
            Selection.Copy
            Worksheets("Combine").Select
            Range("A1").Select
            ActiveSheet.Paste
        Else
        Range("A2:G" & i).Select
        Selection.Copy
        Worksheets("Combine").Select
        j = Range("F" & Rows.Count).End(xlUp).Row
        Range("A" & j + 1).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        End If
    End If
Next


[COLOR=#ff0000]    Dim x As Integer[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]    x = Sheets.Count[/COLOR]
[COLOR=#ff0000]    For i = x To 1 Step -1[/COLOR]
[COLOR=#ff0000]    [/COLOR]
[COLOR=#ff0000]    [/COLOR]
[COLOR=#ff0000]    Next i[/COLOR]




Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

In the red part area, I think i need do until or do...loop through sheets...The reason..

Now my criteria is, in the first part of code..I'm copying data till col G in "combine" sheet. below to each other.

Col G = Jan'18 data (every sheet).

Col H = Feb'18 data
Col I = Mar'18 data
Col J = Apr'18 data
Col K = YTD'2018
Col L = Comments


Now, I need again go to 1st sheet, copy data from A2 till F last rows AND Col H data --> Combine Sheet --> paste in last row + 1...

I dont know how do i loop this till Col L of every sheet..

Note : Last sheet which is "Combine" should ignore in copy task..

 

[VBABEGINER]

Unable to loop or logic..

Sub fnCombine()
Dim i As Long, j As Long, LC As Integer
Dim ws As Worksheet
Dim x As Integer, z As Integer


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
For Each ws In ThisWorkbook.Sheets
    If ws.Name = "Combine" Then
    Else
        ws.Activate
        i = Range("F" & Rows.Count).End(xlUp).Row
        LC = Cells(1, Columns.Count).End(xlToLeft).Column
        If ws.Index = 1 Then
            Range("A1:G" & i).Select
            Selection.Copy
            Worksheets("Combine").Select
            Range("A1").Select
            ActiveSheet.Paste
        Else
        Range("A2:G" & i).Select
        Selection.Copy
        Worksheets("Combine").Select
        j = Range("F" & Rows.Count).End(xlUp).Row
        Range("A" & j + 1).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        End If
    End If
Next


[COLOR=#ff0000]    x = Sheets.Count[/COLOR]
[COLOR=#ff0000]    [/COLOR]
[COLOR=#ff0000]    For z = Range("H") To LC[/COLOR]
[COLOR=#ff0000]    [/COLOR]
[COLOR=#ff0000]    If x.Index = 1 Then[/COLOR]
[COLOR=#ff0000]        Range("H2:H" & i).Select[/COLOR]
[COLOR=#ff0000]        Selection.Copy[/COLOR]
[COLOR=#ff0000]    [/COLOR]
    
    End If
    
    Next z




Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[VBABEGINER]

Can any one, give me logic on this..

 

[VBABEGINER]

As per instruction....which I got yesterday...if no one is able to respond then I can close this thread....

And will post new one, so I can get some help from another query...