Copy worksheet between workbooks

K

kckay

Board Regular
Joined
Nov 8, 2010
Messages
134
I am trying to add a sheet from another workbook to the end of my active workbook using this line of code:

Workbooks("c:\New Inspection Stuff\San Survey Blank Template.xltm").Sheets("System Overview").Copy _
After:=ActiveWorkbook.Sheets(Worksheets.Count)

It is not working.

What am I overlooking?

Thanks.
<!-- / message -->
 
Sort by date Sort by votes
I have not gone all the way through your code or tested it yet, but I did notice this:
Code: 
If Dir(WQCDdiv, vbDirectory) = "" Then
        fsoFSO.createfolder (WQCDdir)
In one spot you used "WQCDdiv" in the other you have "WQCDdir", with an "V" on the end instead of an "R".
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
My source workbbook ("c:\New Inspection Stuff\San Survey Blank.xlsm") currently has 11 worksheets to copy into the new workbook (wkb).

I cannot get it to operate. This code replaced the worksheet add code above.

What am I missing?
.
.
.
Set wkb = ActiveWorkbook

' Open workbook containing blank sorksheets for survey
Set SourceWB = Workbooks.Open(Filename:="c:\New Inspection Stuff\San Survey Blank.xlsm")

' Copy each worksheet from blank survey wookbook to new workbook
Dim ws As Worksheet
For Each ws In SourceWB.Worksheets
SourceWB.Worksheets(ws).Copy After:=wkb.Worksheets(1)
Next ws

' Close the blank survey workbook
SourceWB.Close SaveChanges:=False
.
.
.
 
Upvote 0
I would get no error messages or highlighted lines of code. It would seem to execute, but not copy the worksheets from my source to my target workbooks.

I re-wrote it in a more inefficient and inelegant manner to get it to work. I do not like how I wrote it - the source sheet names are hard-coded within the routine. If we change the name or the number, the coding would have to be modified. It works for now.

Big trouble in Populate_Administrative_Contact() subroutine.

I am having an issue parsing data. I do a find on AC for the Administrative Contact information from my source data. This row has multiple mergeed cells that are of different lengths. There are a variable number of cells that are merged to format the data to be nice and pretty on the screen.

I am trying to extract the Admin Name, Admin Address 1, Admin Address 2, Admin City, Admin State, Admin ZIP, and Admin Phone. These are variable length records (meaning, I do not know how many cells are beween each item of data) so cannot use explicit cell references. How should I loop over the row of data to find each cell with data and assign it to the corresponding target cell?

As an interesting note, Admin Address 2, may or may not have any information and seems to be 15 columns wide.

Code: 
Dim ShtName As String
Dim NameOfFile As String
Dim fsoFSO
Private Sub Populate_Worksheet()
' This will be executed from a button on the "Ribbon" to create this workbook from the SDWIS-generated
' "Comprehensive Water System Report".
' What this sub does:
 
' if directory does not exist
' then
' create directory
' endif
' copy template worksheets to comprehensive_water_system_report workbook
' save file as CEI_PWSID_NAME_DATE.xlsm
' populate general info fields
' populate administrative contact fields (AC)
' populate designated operator contact fields (DO)
' populate operator contact fields (OP)
' populate system inventory
' loop
' facilities
' Facility flows
' endloop
 
WQCDdir = "c:\New Inspection Stuff\"
WQCD_Source_Workbook = WQCDdir & "San Survey Blank.xlsm"
On Error Resume Next
' turn off msgs to streamline creation process
Application.DisplayAlerts = False
 
'if target directory does not exist locally, then create it. Sort of housekeeping to
'create standard directory on each local machine
Set fsoFSO = CreateObject("Scripting.FileSystemObject")
If Dir(WQCDdir, vbDirectory) = "" Then
fsoFSO.createfolder (WQCDdir)
End If
If Dir(WQCDdir & "Reports", vbDirectory) = "" Then
fsoFSO.createfolder (WQCDdir & "Reports")
End If
 
' required name of file is :"CEI_{pwsid}_{Name of system}_date"
'A4 will always contain {pwsid and name of system} as 1 group
NameOfFile = Sheets("Comprehensive Water System Repo").Range("A4").Value
 
'Check if san survey worksheets are already in workbook.
' if so, get out, no need to re-add sheets
' if not, copy all worksheets from the blank workbook to this 'working' workbook
For Each sh In Worksheets
If sh.Name Like "System Overview" Then
nameTaken = True
Exit For
End If
Next
 
If nameTaken = False Then
Set wkb = ActiveWorkbook
With Workbooks.Open(Filename:=WQCD_Source_Workbook)
 
' copy all of the worksheets in the blank workbook
.Worksheets("SDWISInventory Master").Copy Before:=wkb.Worksheets(1)
.Worksheets("Lookup Tables").Copy Before:=wkb.Worksheets(1)
.Worksheets("Site Visit Summary").Copy Before:=wkb.Worksheets(1)
.Worksheets("Inventory Changes").Copy Before:=wkb.Worksheets(1)
.Worksheets("IY12 Deficiencies").Copy Before:=wkb.Worksheets(1)
.Worksheets("Storage").Copy Before:=wkb.Worksheets(1)
.Worksheets("Distribution").Copy Before:=wkb.Worksheets(1)
.Worksheets("Treatment").Copy Before:=wkb.Worksheets(1)
.Worksheets("Sources").Copy Before:=wkb.Worksheets(1)
.Worksheets("System Mgt, M&R, OP ").Copy Before:=wkb.Worksheets(1)
.Worksheets("System Overview").Copy Before:=wkb.Worksheets(1)
 
.Close SaveChanges:=False
 
End With
 
'Save the workbook with defined name
ActiveWorkbook.SaveAs Filename:=(WQCDdir & "CEI_" & NameOfFile & "_" & Date$ & ".xlsm")
 
' Copy data from Comprehensive Water System Report to detail worksheets
ActiveWorkbook.Worksheets("System Overview").Activate
Sheets("System Overview").Select
ActiveSheet.Unprotect Password:="CDPHE"
Call Populate_General_Info
Call Populate_Administrative_Contact
' Call Populate_Designated_Operator
' Call Populate_Operator
' Call Populate_Population_Info
' ActiveSheet.Protect Password:="CDPHE"
 
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
 
Else
MsgBox ("Already populated")
End If
' Save the workbook and worksheets
ActiveWorkbook.Save
 
' turn on messaging
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
 
 
Private Sub Populate_General_Info()
Dim PWSID_Combo As String
Dim PWSID As String
Dim PWSName As String
Dim County_Name As String
Dim PWS_Class As String
Dim Activity_Status As String
Dim FoundData As Range
 
'PWSID is always in A4
PWSID_Combo = Worksheets("Comprehensive Water System Repo").Range("A4")
PWSID = Left(PWSID_Combo, InStr(PWSID_Combo, "-") - 2)
PWSName = Right(PWSID_Combo, Len(PWSID_Combo) - InStr(PWSID_Combo, "-") - 1)
 
'PWSID
'This assignment gives me an error:
Worksheets("System Overview").Range("B6") = PWSID
'PWS Name
'This assignment gives me an error:
Worksheets("System Overview").Range("D6") = PWSName
 
'Search for "Principal County Served" and then add 1 row for COUNTY NAME
Set FoundData = Worksheets("Comprehensive Water System Repo").Cells.Find(What:="Principal County Served", _
LookIn:=xlValues, _
LookAt:=xlPart, _
MatchCase:=False)
County_Name = FoundData.Offset(1, 0)
Worksheets("System Overview").Range("F6") = County_Name
 
'Search for "Fed Type" and then add 3 rows for PWS Classification
'PWS Classification
Set FoundData = Worksheets("Comprehensive Water System Repo").Cells.Find(What:="Fed Type", _
LookIn:=xlValues, _
LookAt:=xlPart, _
MatchCase:=False)
PWS_Class = FoundData.Offset(3, 0)
Worksheets("System Overview").Range("B7") = PWS_Class
 
'Search for "Water System Status" and then add 1 row for Activity Status
Set FoundData = Worksheets("Comprehensive Water System Repo").Cells.Find(What:="Water System Status", _
LookIn:=xlValues, _
LookAt:=xlPart, _
MatchCase:=False)
Activity_Status = FoundData.Offset(1, 0)
Worksheets("System Overview").Range("D7") = Activity_Status
End Sub
 
Private Sub Populate_Administrative_Contact()
Dim FoundData As Range
' Search for "Contacts" in column B, save row number
' Search for "Facilities" in colum B, save row number
' search for "AC" (Administrative Contact) between "Contacts" row and "Factilites" row
' Get the line number of AC in column B
' As each field is merged cells, count # of merged cells and offset for next data
' must figure out "Address 2" problem
 
' Set FoundData = Worksheets("Comprehensive Water System Repo").Cells.Find(What:="Contacts", _
' LookIn:=xlValues, _
' LookAt:=xlPart, _
' MatchCase:=False)
' Contact_Row = FoundData.Row()
'
' Set FoundData = Worksheets("Comprehensive Water System Repo").Cells.Find(What:="Facilities", _
' LookIn:=xlValues, _
' LookAt:=xlPart, _
' MatchCase:=False)
' Facilities_Row = FoundData.Row()
 
Set FoundData = Worksheets("Comprehensive Water System Repo").Cells.Find(What:="AC", _
LookIn:=xlValues, _
LookAt:=xlPart, _
MatchCase:=True)
Admin_Row = FoundData.Row
Admin_Column = FoundData.Column
 
'for each col in FoundData
'if FoundData(col)<>"" then
' copy to corresponding target cell
'end if
'Administrative Contact Name
Worksheets("System Overview").Range("F10") = Admin_Contact_Name
 
'Administrative Contact Address 1
Worksheets("System Overview").Range("F11") = Admin_Address_1
 
'Administrative Contact Address 2
Worksheets("System Overview").Range("F12") = Admin_Address_2
 
'Administrative Contact City
Worksheets("System Overview").Range("F13") = Admin_City
 
'Administrative Contact State
Worksheets("System Overview").Range("F14") = Admin_State
 
'Administrative Contact ZIP
Worksheets("System Overview").Range("F15") = Admin_ZIP
 
'Administrative Contact Phone
Worksheets("System Overview").Range("F16") = Admin_Phone
End Sub
 
Private Sub Populate_Designated_Operator()
End Sub
 
Private Sub Populate_Operator()
End Sub
 
Private Sub Populate_Population_Info()
End Sub

Your help is greatly appreciated.
 
Last edited:
Upvote 0
I am having an issue parsing data. I do a find on AC for the Administrative Contact information from my source data. This row has multiple mergeed cells that are of different lengths. There are a variable number of cells that are merged to format the data to be nice and pretty on the screen.
Click to expand...
Merged Cells and VBA code do not mix.
You can use the Format "Center Selection across cells" and get the same visual effect as Merging a cell without the problems of Merging. I highly recommend removing all Merged cells.

Not sure what you are doing with the following code:
Code: 
'Administrative Contact Name
Worksheets("System Overview").Range("F10") = Admin_Contact_Name
'Administrative Contact Address 1
Worksheets("System Overview").Range("F11") = Admin_Address_1
'Administrative Contact Address 2
Worksheets("System Overview").Range("F12") = Admin_Address_2
'Administrative Contact City
Worksheets("System Overview").Range("F13") = Admin_City
'Administrative Contact State
Worksheets("System Overview").Range("F14") = Admin_State
'Administrative Contact ZIP
Worksheets("System Overview").Range("F15") = Admin_ZIP
'Administrative Contact Phone
Worksheets("System Overview").Range("F16") = Admin_Phone
Are these Admin_ etc... supposed to be Variables? If so, they are not being assigned anywhere. If they are to be Text, they need quote marks around them.
 
Upvote 0
John,
The source worksheet has the cells merged for display purposes. When I select one of the cells, it selects a group and highlights the 'Merge & Center' button. The data is in the first of the cells and then multiples are merged together for the visual.

I need to walk across the cells in the row to find the next cell with data and assign it to one of the Admin variables.
 
Upvote 0
To remove Merged Cells Formatting:
Select cells (Merge and Center button will be highlighted)
Click Merge and Center button

Steps to Center Across Selection:
Be sure your cells have Merge removed.
Select the cells you want to Center.
Ctrl-1 will open the Format Cells Dialog box
Click the Alignment Tab
Under Text Alignment, choose "Center Across Selection" in the Horizontal: Field.
OK to complete.
 
Upvote 0
Cool.

How do I write the loop to get the row that contains 'AC' in column B, then loop to the next cell on that row with data (not blank), assign it to one of the Admin variables, and continue across the row until all of the cells have been examined? The order of the data in the cells is in a fixed order. I am struggling with assigning the Admin variables in sequence. The source has 7 cells with data and the target does, too. The source is horizontal. The target, vertical.

Source:
<TABLE style="WIDTH: 773pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=1015><COLGROUP><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" span=5 width=12><COL style="WIDTH: 7pt; mso-width-source: userset; mso-width-alt: 341" width=10><COL style="WIDTH: 3pt; mso-width-source: userset; mso-width-alt: 142" width=4><COL style="WIDTH: 8pt; mso-width-source: userset; mso-width-alt: 398" width=11><COL style="WIDTH: 5pt; mso-width-source: userset; mso-width-alt: 256" width=7><COL style="WIDTH: 4pt; mso-width-source: userset; mso-width-alt: 170" width=5><COL style="WIDTH: 2pt; mso-width-source: userset; mso-width-alt: 85" width=2><COL style="WIDTH: 17pt; mso-width-source: userset; mso-width-alt: 796" width=22><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 7pt; mso-width-source: userset; mso-width-alt: 341" width=10><COL style="WIDTH: 2pt; mso-width-source: userset; mso-width-alt: 85" width=2><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" span=3 width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 7pt; mso-width-source: userset; mso-width-alt: 341" width=10><COL style="WIDTH: 2pt; mso-width-source: userset; mso-width-alt: 85" width=2><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 19pt; mso-width-source: userset; mso-width-alt: 881" width=25><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 11pt; mso-width-source: userset; mso-width-alt: 512" width=14><COL style="WIDTH: 7pt; mso-width-source: userset; mso-width-alt: 341" width=10><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 7pt; mso-width-source: userset; mso-width-alt: 341" width=10><COL style="WIDTH: 2pt; mso-width-source: userset; mso-width-alt: 85" width=2><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 2pt; mso-width-source: userset; mso-width-alt: 85" width=2><COL style="WIDTH: 7pt; mso-width-source: userset; mso-width-alt: 341" width=10><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 5pt; mso-width-source: userset; mso-width-alt: 256" width=7><COL style="WIDTH: 2pt; mso-width-source: userset; mso-width-alt: 85" span=2 width=2><COL style="WIDTH: 4pt; mso-width-source: userset; mso-width-alt: 170" width=5><COL style="WIDTH: 5pt; mso-width-source: userset; mso-width-alt: 256" width=7><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" span=2 width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 19pt; mso-width-source: userset; mso-width-alt: 881" width=25><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 5pt; mso-width-source: userset; mso-width-alt: 256" width=7><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 3pt; mso-width-source: userset; mso-width-alt: 142" width=4><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 5pt; mso-width-source: userset; mso-width-alt: 227" width=6><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 5pt; mso-width-source: userset; mso-width-alt: 227" width=6><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" span=2 width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 4pt; mso-width-source: userset; mso-width-alt: 170" width=5><COL style="WIDTH: 5pt; mso-width-source: userset; mso-width-alt: 256" width=7><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 7pt; mso-width-source: userset; mso-width-alt: 341" width=10><COL style="WIDTH: 2pt; mso-width-source: userset; mso-width-alt: 85" width=2><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" span=2 width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" span=2 width=1><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 56" width=2><COL style="WIDTH: 7pt; mso-width-source: userset; mso-width-alt: 341" width=10><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 13pt; mso-width-source: userset; mso-width-alt: 625" width=18><COL style="WIDTH: 5pt; mso-width-source: userset; mso-width-alt: 256" width=7><COL style="WIDTH: 10pt; mso-width-source: userset; mso-width-alt: 455" width=13><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" span=2 width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 10pt; mso-width-source: userset; mso-width-alt: 455" width=13><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" span=2 width=12><COL style="WIDTH: 5pt; mso-width-source: userset; mso-width-alt: 227" span=2 width=6><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" span=2 width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" span=2 width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" span=2 width=1><COL style="WIDTH: 7pt; mso-width-source: userset; mso-width-alt: 341" width=10><COL style="WIDTH: 11pt; mso-width-source: userset; mso-width-alt: 512" width=14><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" span=2 width=12><COL style="WIDTH: 19pt; mso-width-source: userset; mso-width-alt: 881" width=25><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" span=2 width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" span=2 width=12><COL style="WIDTH: 1pt; mso-width-source: userset; mso-width-alt: 28" width=1><COL style="WIDTH: 9pt; mso-width-source: userset; mso-width-alt: 426" width=12><TBODY><TR style="HEIGHT: 14.4pt; mso-height-source: userset" height=19><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 9pt; HEIGHT: 14.4pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl65 height=19 width=12></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 63pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl67 width=85 colSpan=9>AC </TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 121pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl68 width=159 colSpan=16>DOE, JOHN</TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 173pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl69 width=226 colSpan=34>949 E 2ND AVE</TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 9pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=12></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 19pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=25></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 1pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=1></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 5pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=7></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 1pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=1></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 3pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=4></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 1pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=1></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 9pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=12></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 5pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=6></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 1pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=1></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 5pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=6></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 9pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=12></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 9pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=12></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 1pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=1></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 68pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl68 width=90 colSpan=16>DURANGO</TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 27pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl68 width=37 colSpan=3>CO</TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 58pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl68 width=76 colSpan=9>81301</TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 89pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl68 width=115 colSpan=16>970-375-4887 </TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 59pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl68 width=77 colSpan=9> </TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 9pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl66 width=12></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 9pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl65 width=12></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 1pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl65 width=1></TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 9pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl65 width=12></TD></TR></TBODY></TABLE>


Target:
<TABLE style="WIDTH: 196pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=260><COLGROUP><COL style="WIDTH: 101pt; mso-width-source: userset; mso-width-alt: 4778" width=134><COL style="WIDTH: 95pt; mso-width-source: userset; mso-width-alt: 4494" width=126><TBODY><TR style="HEIGHT: 27pt" height=36><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 101pt; HEIGHT: 27pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl69 height=36 width=134> </TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 95pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl71 width=126>Designated Operator Contact</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 101pt; HEIGHT: 14.4pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl72 height=19 width=134>Contact:</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt dotted; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 95pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl73 width=126>DOE, JOHN</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 101pt; HEIGHT: 14.4pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl72 height=19 width=134>Address:</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt dotted; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 95pt; BORDER-TOP: windowtext; BORDER-RIGHT: #f2ecd7" class=xl74 width=126>949 2ND AVE</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 101pt; HEIGHT: 14.4pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl72 height=19 width=134>Address:</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt dotted; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 95pt; BORDER-TOP: windowtext; BORDER-RIGHT: #f2ecd7" class=xl74 width=126> </TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 101pt; HEIGHT: 14.4pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl72 height=19 width=134>City:</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt dotted; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 95pt; BORDER-TOP: windowtext; BORDER-RIGHT: #f2ecd7" class=xl74 width=126>DURANGO</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 101pt; HEIGHT: 14.4pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl72 height=19 width=134>State:</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt dotted; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 95pt; BORDER-TOP: windowtext; BORDER-RIGHT: #f2ecd7" class=xl74 width=126>CO</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 101pt; HEIGHT: 14.4pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl72 height=19 width=134>Zip Code:</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt dotted; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 95pt; BORDER-TOP: windowtext; BORDER-RIGHT: #f2ecd7" class=xl75 width=126>81301</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 101pt; HEIGHT: 14.4pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl72 height=19 width=134>Phone #: </TD><TD style="BORDER-BOTTOM: windowtext 0.5pt dotted; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 95pt; BORDER-TOP: windowtext; BORDER-RIGHT: #f2ecd7" class=xl76 width=126>970-555-5555</TD></TR><TR style="HEIGHT: 14.4pt" height=19><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 101pt; HEIGHT: 14.4pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl72 height=19 width=134> </TD><TD style="BORDER-BOTTOM: #f2ecd7; BORDER-LEFT: #f2ecd7; BACKGROUND-COLOR: transparent; WIDTH: 95pt; BORDER-TOP: #f2ecd7; BORDER-RIGHT: #f2ecd7" class=xl77 width=126></TD></TR></TBODY></TABLE>
The loop to extract the data from the source and assign it to the target is kicking me in the pants.
 
Upvote 0
This code gathers data from Sheet1 and copies to Sheet2.
Adjust sheet names as needed.
Code: 
Sub CopyOnlyValues()
Dim Rng1 As Range
Dim Rng2 As Range
Dim a As Range
Dim c As Range
    'Assigning variables for Sheet names allows code to be run from any worksheet
    'Assign variables for Target and Source Sheets
    ts = "Sheet1"
    ss = "Sheet2"
    'Assign variable for LastRow of Target Sheet
    lr = Sheets(ts).Cells(Sheets(ts).Rows.Count, "B").End(xlUp).Row + 1
    'Assign Start Row of Source sheet
    sr = Sheets(ss).Cells.Find(What:="Contact Type", After:=ActiveCell, LookAt:=xlWhole).Row + 2
    lr2 = Sheets(ss).Cells(Sheets(ss).Rows.Count, "A").End(xlUp).Row
    'Assign Ranges for Source
    Set Rng1 = Sheets(ss).Range(Sheets(ss).Cells(sr, 1), Sheets(ss).Cells(lr2, 1))
    If Not Range("A" & sr).Offset(2, 0).Value = "" Then
        'Loop through items in Rng1
        For Each a In Rng1
            If Not a = "" Then
                cr = a.Row
                lastcol = Sheets(ss).Cells(cr, Sheets(ss).Columns.Count).End(xlToLeft).Column
                Set Rng2 = Sheets(ss).Range(Sheets(ss).Cells(cr, 1), Sheets(ss).Cells(cr, lastcol))
                'Loop through items in Rng2
                For Each c In Rng2
                    If Not c = "" Then
                        Sheets(ts).Range("B" & lr).Value = c.Value
                        lr = lr + 1
                    End If
                Next c
            End If
        Next a
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Copy and Re-Name Worksheet using a cell value.
Replies
3
Views
283
Logit
Logit
P
  • Solved
Export Worksheets into a Single PDF using Criteria on each Worksheet
Replies
7
Views
689
jolivanes
jolivanes
sharky12345
  • Question Question
Error 1004 - Copy method of Worksheet class failed
Replies
1
Views
131
yoseeeph
Y
S
  • Question Question
Copy Formula result as value into find
Replies
4
Views
147
myall_blues
myall_blues
P
  • Question Question
How to copy specific worksheets into a new workbook but with values only?
Replies
2
Views
376
phyxius117
P

Forum statistics

Threads
1,224,600
Messages
6,179,833
Members
452,947
Latest member
Gerry_F

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