Is there a "Set sourceRange =" for all sheets in workbook

[Bill Metzgar via OfficeKB.com]

Hello,

Is there a way to make
Set sourceRange = Sheets("Sheet1").Columns("D")
reference column D in all worksheets instead of just "Sheet1" ? I'm
looking for a global 'all sheets in workbook' command and can't seem to
find one. I realize that I can list all the sheets by individual name
Sheets(Array("Sheet2", "Main", "Control Sheet", "ZDV 08 FL270-359", _
"ZDV 08 FL270-369", "ZDV 08 FL270-379"))
OR
Sheets(Sheet2", "Main", "Control Sheet", "ZDV 08 FL270-359", _
"ZDV 08 FL270-369", "ZDV 08 FL270-379")
but I wanted to try and do this in one shot.

Any help is appreciated
Thanks,
Bill

PS Here is the code that I found online and am trying to adapt to copy
column D from all sheets to a collection sheet where it will insert in the
next empty colum:
Sub CopyColumnew()
Dim sourceRange As Range
Dim destrange As Range
Dim Lc As Integer
Lc = Lastcol(Sheets("Main")) + 1
Set sourceRange = Sheets("Sheet1").Columns("D")
Set destrange = Sheets("Main").Columns(Lc)
sourceRange.Copy destrange
End Sub

Sub CopyColumnValues()
Dim sourceRange As Range
Dim destrange As Range
Dim Lc As Integer
Lc = Lastcol(Sheets("Main")) + 1
Set sourceRange = Sheets("Sheet1").Columns("D")
Set destrange = Sheets("Main").Columns(Lc). _
Resize(, sourceRange.Columns.Count)
destrange.Value = sourceRange.Value
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("D1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("D1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

 

[Guest]

If I understand you correctly you want to copy the contents of Column D from
every sheet to a single sheet, moving the column as you go. Since you need to
move the column as you go you will have some difficulty with your current
code. Here is some code that I think does what you want.

Option Explicit

Public Sub CopyColumns()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngCopyTo As Range

Set wksCopyTo = ActiveSheet
Set rngCopyTo = wksCopyTo.Range("A1")

For Each wksCopyFrom In Worksheets
If wksCopyFrom.Name <> wksCopyTo.Name Then
wksCopyFrom.Range("D1").EntireColumn.Copy rngCopyTo
Set rngCopyTo = rngCopyTo.Offset(0, 1)
End If
Next wksCopyFrom
End Sub

I am traversing through the worksheets collection and so long as I am not on
my CopyTo sheet then I Copy Column D and paste it into my copy to range which
is on my copy to sheet. I then move my copy to range once cell to the right...

HTH

 

[Bill Metzgar via OfficeKB.com]

Thanks a ton Jim! That works great but how can I keep the code from
1) starting it's copy at column 3 or C
2) erasing the data that is already on the page (in case it's run by
accident)or only write to a sheet named 'Main'

As you can tell I haven't done much script writing...I just rewrite stuff
I find to suit the outcome I need. I'm surprised that there isn't a global
all sheets statement but maybe VBA wasn't designed that way

Thanks for the help!
Bill

 

[Guest]

Here is some new code for you. It does not overwrite and it prompts the user
that they have already copied once if they have. My assumption in this code
is that there is always a value in column D1 of all sheets (this is used to
find the first free column). You can chage this by changing the IV1 to IV?
depending which row always ahs something in it. If this won't work out for
you let me know. As to your first question did you now want to copy Columns C
and D or just what. I don't understand...

Option Explicit

Public Sub CopyColumns()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngCopyTo As Range
Dim blnProceed As Boolean

Set wksCopyTo = Sheets("Main")
Set rngCopyTo = wksCopyTo.Range("IV1").End(xlToLeft)
blnProceed = True

If rngCopyTo.Column <> 1 Then
If MsgBox("You have already copied to the main sheet before. " & _
"Did you want to proceed?", vbYesNo, "Proceed") = vbYes Then
Set rngCopyTo = rngCopyTo.Offset(0, 1)
Else
blnProceed = False
End If
End If

If blnProceed = True Then
For Each wksCopyFrom In Worksheets
If wksCopyFrom.Name <> wksCopyTo.Name Then
wksCopyFrom.Range("D1").EntireColumn.Copy rngCopyTo
Set rngCopyTo = rngCopyTo.Offset(0, 1)
End If
Next wksCopyFrom
End If
End Sub

HTH

 

[Bill Metzgar via OfficeKB.com]

That works great too
What I meant by: 1) starting it's copy at column 3 or C
is that the macro skips two columns before copying i.e. if the sheet is
empty the paste starts at column C instead of starting at column A then
subsequent runs leave two columns empty between previously pasted columns
and the newly pasted columns. None of that is a big deal though...
Thanks so much for your time!

Bill

 

[Guest]

Your whim is my command... Here it is. Untested but I think it should work...

Public Sub CopyColumns()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngCopyTo As Range
Dim blnProceed As Boolean

Set wksCopyTo = Sheets("Main")
Set rngCopyTo = wksCopyTo.Range("IV1").End(xlToLeft).Offset(0, 2)
blnProceed = True

If rngCopyTo.Column <> 1 Then
If MsgBox("You have already copied to the main sheet before. " & _
"Did you want to proceed?", vbYesNo, "Proceed") = vbYes Then
Set rngCopyTo = rngCopyTo.Offset(0, 1)
Else
blnProceed = False
End If
End If

If blnProceed = True Then
For Each wksCopyFrom In Worksheets
If wksCopyFrom.Name <> wksCopyTo.Name Then
wksCopyFrom.Range("D1").EntireColumn.Copy rngCopyTo
Set rngCopyTo = rngCopyTo.Offset(0, 1)
End If
Next wksCopyFrom
End If
End Sub


HTH

 

[Bill Metzgar via OfficeKB.com]

Thanks for the effort...I truly appreciate it!
...this version leaves 4 columns between instead of two. I'll play with
the offset a bit on Monday when I get back to work
Thanks Again!

Bill