时间戳

首页 > 解决方案 > 浏览列并复制单元格

excel - 浏览列并复制单元格

问题描述

如果有数据，我编写的代码会转到每一行，并将数据复制到特定单元格中的不同文件中。

现在我想遍历每一列而不是行，直到没有数据为止。

我的行代码是：

Sub Row_copying()

'load my workbooks

Dim Header As Workbook
Workbooks.Open FileName:="/Users/Header.xlsx"
Set Header = Workbooks("Header.xlsx")

Dim samplelist As Workbook
Workbooks.Open FileName:="/Users/samplelist.xlsx"
Set samplelist = Workbooks("samplelist.xlsx")

samplelist.Activate

' Loop through each row that has data
Dim lRow As Long

For lRow = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Range("A" & lRow).Value <> "" Then
        'copy cell
        Range("D" & lRow).Copy
        Header.Activate
        Range("K5:M5").Select
        ActiveSheet.Paste

        samplelist.Activate
        Range("H" & lRow).Copy
        Header.Activate
        Range("F5:G5").Select
        ActiveSheet.Paste

        Dim DName As String, dataname As String, path As String
        samplelist.Activate
        path = "/Users/newdata/"
        DName = "sample_"
        dataname = path & DName & Format(Range("A") & lRow.Value, "000") & ".xlsx"
        Header.Activate
        ActiveWorkbook.SaveAs FileName:= dataname
    End If
    samplelist.Activate
Next lRow
Workbooks("samplelist.xlsx").Close
End Sub

我可以通过将 lRow 更改为来检查有多少列有数据

lCol = Cells(1, Columns.Count).End(xlToLeft).Column
MsgBox"last Column: "&lCol

我无法管理它遍历每一列并复制单元格。

标签： excelvba

解决方案

您可以使用 Cells(x,y)，而不是使用 Range() 来引用您正在检查的单元格。由于您知道您拥有的行数和列数，您可以有一个嵌套的 For 即 For Each Row Loop All Columns。

Option Explicit

Public Sub sCopy()

  Dim numberOfColumns As Long, numberOfRows As Long
  Dim x As Long, y As Long
  Dim ws As Worksheet

  'set number of rows/columns
  'set workbooks / worksheets

  For x = 1 To numberOfRows
    For y = 1 To numberOfColumns
      If ws.Cells(x, y).Value <> "" Then
       'Do what you have to do
      End If
    Next y
  Next x

End Sub

推荐阅读