Consolidate - Copy Data from multiple sheets into One Sheet

[gentibr]

Hello,


I am a beginner in using the VBA code and need some help. What I am trying to achieve is to Copy the data from Column F(F6:F8, F12:F14, F18:F23, F26:F33, F37:F38, F42:F50)of all the Sheet(so far from Sheet 1 to Sheet 41) and paste these data on on the PE Master Sheet on the respective cells E#:G#, I#:K#, M#:R#, T#:AA#, AC#:AD#, AF#:AN#).


So for e.g.


For Sheet 1: the only data copied are from (Column F) CellsF6:F8, F12:F14, F18:F23, F26:F33, F37:F38, F42:F50). These data then have to populate the Master PE Sheet only in the following order of Cells: E4:G4, I4:K4, M4:R4, T4:AA4, AC4:AD4, AF4:AN4).


For Sheet 2: he only data copied are from (Column F) Cells: (F6:F8, F12:F14, F18:F23, F26:F33, F37:F38, F42:F50). These data then have to populate the Master PE Sheet (only in these Cells: E5:G5, I5:K5, M5:R5, T5:AA5, AC5:AD5, AF5:AN5).


The same approach or logic have to be used for Sheet 3-41 and if there are new sheets added in the future (let's say 42, 43 and so on) include them, as well. Moreover, in Column B, starting in Cell B4 insert the name of the sheet from which the data have been copied.


Thank you in advance for your cooperation!

 

[Faseeh]

Hi gentibr,


Welcome to the Forums!!!!


Please upload a sample file, this will help people around to solve your problem.


Regards,

 

[SirJB7]

Hi, gentibr!


Give a look at this file:

https://dl.dropbox.com/u/60558749/Consolidate%20-%20Copy%20Data%20from%20multiple%20sheets%20into%20One%20Sheet%20%28for%20gentibr%20at%20chandoo.org%29.xlsm


Here's the code:

-----

[pre]

Option Explicit

Sub CopyToPE()
' constants
Const ksWSMaster = "PE Master"
Const ksWSSlaves = "*"
Const ksRngInput = ",F6:F8,F12:F14,F18:F23,F26:F33,F37:F38,F42:F50"
Const ksRngOutput = ",E,I,M,T,AC,AF"
Const kiRngOutputRow = 3
Const ksDelimiter = ","
Const ksDummy = "1"
' declarations
Dim ws As Worksheet, rngI As Range
Dim sWS As String, sRngInput() As String, sRngOutput() As String
Dim iRngOutputRow As Integer, iRngOutputColumn As Integer
Dim I As Integer, J As Integer, K As Integer
' start
'  output range
Set ws = Worksheets(ksWSMaster)
With ws
.Range(.Rows(kiRngOutputRow + 1), .Rows(.Rows.Count)).Select
Selection.ClearContents
End With
'  range arrays
sRngInput() = Split(ksRngInput, ksDelimiter)
sRngOutput() = Split(ksRngOutput, ksDelimiter)
iRngOutputRow = kiRngOutputRow
' process
With ActiveWorkbook
For I = 1 To .Worksheets.Count
With .Worksheets(I)
If .Name <> ksWSMaster And .Name Like ksWSSlaves Then
iRngOutputRow = iRngOutputRow + 1
For J = 1 To UBound(sRngInput())
iRngOutputColumn = Range(sRngOutput(J) & ksDummy).Column - 1
Set rngI = Worksheets(.Name).Range(sRngInput(J))
For K = 1 To rngI.Cells.Count
ws.Cells(iRngOutputRow, iRngOutputColumn + K).Value = _
rngI.Cells(K).Value
Next K
Set rngI = Nothing
Next J
End If
End With
Next I
End With
' end
Set ws = Nothing
End Sub

[/pre]
-----


Just advise if any issue.


Regards!